2013-04-29 46 views
8

Tôi cần phải viết macro như vậy: Tôi điền vào A1 bằng màu đen. Sau đó, khi tôi chạy macro, A2 phải nhẹ hơn một chút, A3 thậm chí còn nhẹ hơn ... vv cho đến khi A20 có màu trắng. Giá trị ô "F5" phải kiểm soát mức độ số mũ gradient. Mã hiện tại thay đổi màu tương ứng. Khi tôi thay đổi giá trị trong "F5" (ví dụ: từ 1 đến 0,7), điều xảy ra là TẤT CẢ của 20 ô đó ("A1: A20") trở nên tối hơn EQUALLY. Và tế bào cuối cùng A20 không còn màu trắng nữa.Làm thế nào để buộc các tế bào excel thay đổi màu sắc EXPONENTIALLY?

Tuy nhiên, tôi cần ô nắm tay "A1" là màu đen và ô cuối cùng "A20" là màu trắng không có vấn đề gì ... Và phân phối màu cho các ô phải là EXPONENTIAL, tức là sự khác biệt giữa bóng tối A1 và A2 nên HAI lần (nếu "F5" == 2) lớn như sự khác biệt giữa bóng tối A3 và A2, vv ...

Sub Macro3() 

    Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others. 
    Dim cellColor As Long 'the cell color that you will use, based on firstCell 
    Dim allCells As Range 'all cells in the column you want to color 
    Dim c As Long 'cell counter 
    Dim tintFactor As Double 'computed factor based on # of cells. 
    Dim contrast As Double 'double precision factor for changing the contrast 0= none higher is more 

    Set firstCell = Range("A1") 
    cellColor = firstCell.Interior.Color 
    contrast = Range("F5").Value 


    Set allCells = Range("A1:A20") 

    For c = allCells.Cells.Count To 1 Step -1 
     allCells(c).Interior.Color = cellColor 
     allCells(c).Interior.TintAndShade = _ 
      contrast * (c - 1)/(allCells.Cells.Count -1) 

    Next 

tôi không thể tìm ra, chức năng gì thế nào tôi nên thực hiện ở trên để các thay đổi màu sắc sẽ được theo cấp số nhân, như tôi thay đổi giá trị cho varialbe contrast trong "F5"? // VÀ

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("F5")) Is Nothing Then 
     Call Macro3 
    End If 
End Sub 

enter image description here

+0

bạn có cần có giá trị chính xác trong cột B như được trình bày hoặc tương tự không? –

+0

@KazJaw Tôi chỉ cần tương tự. Tôi chỉ cố gắng cho một ví dụ mô tả những gì tôi cần. – Buras

Trả lời

6

Bạn không thể có cả "các tế bào tiếp theo là gấp đôi trắng" và "ô đầu tiên là màu đen và ô cuối cùng là màu trắng". Những gì bạn đang tìm kiếm là một cái gì đó gọi là "chức năng gamma" - một mức độ tỉ lệ của các số từ 0 đến 255, nơi tốc độ mà chúng trở nên nhẹ hơn phụ thuộc vào yếu tố (đôi khi được gọi là gamma).

Ở dạng cơ bản của nó, bạn có thể sử dụng một cái gì đó như:

contrast = ((cellNum-1)/(numCells-1))^gamma 

Bây giờ, nếu gamma của bạn là 1, mở rộng quy mô sẽ được tuyến tính. Khi gamma> 1, cường độ sẽ tăng nhanh hơn cho các ô cuối cùng. Khi nó nhỏ hơn 1, nó sẽ thay đổi nhanh chóng cho một vài ô đầu tiên.

Tôi giả định ở trên rằng cellNum chuyển từ 1 đến 20 và numCells là 20. Giá trị này tương phản, trong biểu thức .TintAndShade bạn đang sử dụng, sẽ cung cấp cho bạn hiệu quả bạn đang tìm kiếm. gamma không cần phải là số nguyên, nhưng nếu đó là < 0 bạn sẽ nhận được độ tương phản> 1 và điều đó sẽ cho bạn kết quả lạ (tất cả màu trắng, tôi tưởng tượng).

Bằng cách này - đổi tên macro3 của bạn để một cái gì đó hợp lý hơn (adjustContrast), và gọi nó với giá trị của F5 như một tham số:

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("F5")) Is Nothing Then 
    adjustContrast Target.Value 
    End If 
End Sub 

Sub adjustContrast(gamma) 
    ... etc 

Vì nó là rõ ràng từ nhận xét của bạn rằng tôi không đủ rõ ràng trong bài đăng gốc của tôi, đây là mã hoàn chỉnh và kết quả nó mang lại cho tôi.Lưu ý - đây là code để chứng minh hiệu quả của việc thay đổi gamma trên màn hình, không phải là mã chính xác mà bạn muốn sử dụng (ví dụ, tôi vòng qua bốn cột và có bốn giá trị khác nhau của gamma):

Sub applyGamma() 
Dim ii, jj As Integer 
Dim contrast As Double 
Dim cellColor, fontColor, fontInvColor As Long 
Dim allCells As Range 
Dim gamma As Double 

On Error GoTo recovery 
Application.ScreenUpdating = False 
Set allCells = [A2:A21] 

' default formatting taken from cell A1 
cellColor = [A1].Interior.Color 
fontColor = [A1].Font.Color 
fontInvColor = 16777215 - fontColor ' use the "inverse" color... sloppy way to always see the numbers 

For jj = 1 To 4 
    Set allCells = allCells.Offset(0, 1) 
    gamma = Cells(1, jj + 1).Value ' pick gamma from the column header 
    For ii = 1 To 20 ' loop over all the cells 
    contrast = ((ii - 1)/19)^gamma ' pick the contrast for this cell 
    allCells.Cells(ii, 1).Interior.Color = cellColor 
    allCells(ii, 1).Interior.TintAndShade = contrast 
    If contrast > 0.5 Then allCells.Cells(ii, 1).Font.Color = fontInvColor Else allCells(ii, 1).Font.Color = fontColor 

    Next ii 
    ' repeat for next column: 
Next jj 

recovery: 
Application.ScreenUpdating = True 

End Sub 

Trước tôi chạy mã, màn hình của tôi trông như thế này (các giá trị trong các tế bào là những giá trị tương phản tính toán cho gamma nhất định):

enter image description here

Sau khi chạy nó, nó trông như thế này:

enter image description here

Như bạn có thể thấy, tôi đã thêm "tính năng" bổ sung: màu của phông chữ được thay đổi để hiển thị mọi thứ. Điều này giả định, tất nhiên, rằng "ô mẫu" (trong trường hợp của tôi, A1) có độ tương phản tốt giữa phông chữ và màu tô.

+0

Tôi đã phóng đại khoảng hai lần tối hơn chỉ đơn giản là để làm cho quan điểm của tôi, và để mô tả nó rõ ràng hơn. Tôi trực giác biết nên có một số '^' số mũ trong công thức 'tương phản' của tôi. Tuy nhiên, tôi không thể tìm ra cách tôi nên sửa mã của mình. Tôi đã thử 'gamma' như bạn đã đề nghị nhưng không nhận được bất kỳ kết quả tích cực nào. Bạn có thể vui lòng sửa mã của tôi với bất kỳ chức năng kiểm tra nào, để nó hoạt động không? – Buras

+0

@Buras - Tôi đã mở rộng câu trả lời của mình bằng một macro hoạt động đầy đủ và một vài ảnh chụp màn hình để bạn có thể thấy chính xác những gì đang diễn ra. – Floris

+0

Cảm ơn bạn. Câu trả lời rất chi tiết – Buras

4

Để có nó làm việc theo cấp số nhân bạn có thể thử sử dụng logic mà kết quả với sau:

enter image description here

Các mã sau đây được một chút thay đổi so với bạn một:

Sub Macro3_proposal_revers() 

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others. 
Dim cellColor As Long 'the cell color that you will use, based on firstCell 
Dim allCells As Range 'all cells in the column you want to color 
Dim c As Long 'cell counter 
Dim tintFactor As Double 'computed factor based on # of cells. 
Dim contrast As Integer 

Set firstCell = Range("B1") 
cellColor = firstCell.Interior.Color 
    contrast = Range("F5").Value 

Set allCells = Range("B1:B20") 

Dim allCellsCount! 
allCellsCount = allCells.Cells.Count - 1 
Dim newContrast As Double 
For c = 1 To allCells.Cells.Count - 1 

    allCells(c + 1).Interior.Color = cellColor 
    'var 1 
    newContrast = (1 - 0.9^(c * (1 + (c/allCellsCount))) * contrast) 

    allCells(c + 1).Interior.TintAndShade = newContrast 

    'control value- to delete 
    allCells(c + 1).Offset(0, 1).Value = allCells(c + 1).Interior.TintAndShade 
    Next 

End Sub 

là gì quan trọng - nhìn vào dòng này:

newContrast = (1 - 0.9^(c * (1 + (c/allCellsCount))) * contrast) 

nơi bạn có thể làm bất cứ điều gì bạn muốn, ví dụ: thay đổi: (1 + (c/allCellsCount)) vào thứ gì đó từ 1 đến 2 để hiểu cách logic. Nói chung, bạn có thể điều chỉnh tốc độ thay đổi bóng thao tác dòng này, đặc biệt là thao tác với phần này của mã: (c * (1 + (c/allCellsCount))

+0

Cảm ơn bạn @KazJaw – Buras

Các vấn đề liên quan