Wie erzwingen Excel-Zellen, Farben EXPONENTIALLY zu ändern?

Question

Ich muss ein Makro schreiben, so dass: Ich fülle A1 mit einer schwarzen Farbe. Dann, wenn ich das Makro benutze, sollte A2 etwas heller sein, A3 noch leichter ... usw., bis A20 weiß ist. Der "F5" -Zellenwert sollte den Grad des Gradientenexponenten steuern. Der aktuelle Code ändert die Farbe proportional. Wenn ich Werte in "F5" (z. B. von 1 bis 0,7) ändere, passiert, dass ALLE dieser 20 Zellen ("A1: A20") EQUAL dunkler werden. Und die letzte Zelle A20 ist nicht mehr weiß.

Allerdings brauche ich meine Faust Zelle "A1" schwarz und die letzte Zelle "A20" weiß egal was ... Und die Verteilung der Farbe für die Zellen sollte EXPONENTIAL sein, dh die Dunkelheit Differenz zwischen A1 und A2 sollte zwei mal (wenn „F5“ == 2) so groß wie die Differenz zwischen der Dunkelheit A3 und A2, etc ...

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 

I nicht herausfinden kann, welche Funktion sollte ich oben implementieren, so dass die Farbänderung wäre exponentiell, wie ich den Wert für die Variable contrast in "F5" ändern? // UND

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

Answer 1

Sie können nicht beide „die nächste Zelle doppelt so weiß ist“ und „die erste Zelle ist schwarz und die letzte Zelle ist weiß“. Was Sie suchen, ist eine sogenannte "Gammafunktion" - ein Grad der Skalierung von Zahlen von 0 bis 255, wobei die Geschwindigkeit, mit der sie heller werden, von einem Faktor abhängt (manchmal als Gamma bezeichnet).

In seiner Grundform, können Sie so etwas wie verwenden:

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

Nun, wenn Ihr Gamma 1 ist, wird die Skalierung linear sein. Wenn gamma> 1 ist, wird die Intensität für die letzten paar Zellen schneller ansteigen. Wenn es weniger als 1 ist, wird es sich für die ersten paar Zellen schnell ändern.

ich in der oben gehe davon aus, dass die cellNum von 1 bis 20 geht, und dass numCells ist 20. Dieser Wert Gegensatz dazu wird im .TintAndShade Ausdruck, den Sie verwendet haben, sollte Ihnen die Wirkung die Sie suchen. gamma muss nicht eine Ganzzahl sein, aber wenn es < 0 ist, erhalten Sie Kontrast> 1, und das wird Ihnen seltsame Ergebnisse (alles weiß, stelle ich mir vor).

By the way - benennen Sie Ihre macro3 etwas empfindlicheren (adjustContrast), und es mit dem Wert von F5 Aufruf als Parameter:

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

und

Sub adjustContrast(gamma) 
    ... etc 

Da war es klar, von deinem Kommentar, dass ich in meinem ursprünglichen Beitrag nicht explizit genug war, hier ist vollständiger Code und die Ergebnisse, die es mir gibt.Hinweis - dieser Code ist es, die Wirkung der Änderung Gamma auf dem Display, nicht die genaue Code, den Sie verwenden möchten, zeigen (zum Beispiel I Schleife über vier Spalten und vier verschiedene Werte von 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 

Vor ich betreibe den Code, mein Bildschirm sieht wie folgt aus (die Werte in den Zellen sind berechneten Kontrastwerte für den gegebenen Gamma):

Nachdem es läuft, sieht es wie folgt aus:

Wie Sie sehen können, habe ich ein zusätzliches "Feature" hinzugefügt: Die Färbung der Schriftart wurde geändert, um Dinge sichtbar zu halten. Dies setzt natürlich voraus, dass die "Template-Zelle" (in meinem Fall A1) einen guten Kontrast zwischen den Schrift- und Füllfarben hat.

Answer 2

Um es exponentielle arbeiten Sie Logik verwenden könnten versuchen, die mit folgenden führen:

Der folgende Code leicht geändert wird, im Vergleich zu Ihrer ein:

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 

Was wichtig ist, - schau in diese Zeile:

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

wo Sie tun können, was Sie wollen, z. Ändern Sie: (1 + (c/allCellsCount)) in etwas zwischen 1 bis 2, um den Weg der Logik zu verstehen. Im Allgemeinen können Sie das Tempo der Schattierungsänderung anpassen, die diese Linie manipuliert, insbesondere mit diesem Teil des Codes manipulieren: (c * (1 + (c/allCellsCount))