2013-04-29 58 views
8

我需要寫一個宏,以便:我用黑色填充A1。然後當我運行宏時,A2應該稍微輕一些,A3甚至更輕......等到A20變白。 「F5」單元值應該控制梯度指數的程度。 當前代碼按比例改變顏色。當我改變「F5」的值(例如從1到0.7)時,發生的是所有這20個單元(「A1:A20」)變得等於較暗。而最後一個單元格A20不再是白色。如何強制excel單元更改顏色EXPONENTIALLY?

然而,我需要我的拳頭細胞「A1」爲黑色,最後一個細胞「A20」爲白色無論如何...而且,細胞的顏色分佈應該是指數,即A1和A2之間暗之間的差別應該是兩次(如果「F5」 == 2)大到A3和A2等之間的暗之間的差別......

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 

我想不出,有什麼功能我是否應該在上面實現,以便顏色變化爲指數,因爲我在「F5」中更改了變量contrast的值? //和

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中提供精確值(如所示)或類似的東西? – 2013-04-29 05:21:13

+0

@KazJaw我只需要類似。我只是試圖展示一個能夠描述我需要的例子。 – Buras 2013-04-29 05:58:03

回答

6

你不能兼得「的下一個單元格的兩倍,白」和「第一個單元格是黑色,最後一個單元格是白的」。你正在尋找的是一種叫做「伽馬函數」的東西 - 數字從0到255的縮放程度,其中它們變得更輕的速率取決於一個因子(有時稱爲伽馬)。

在其基本形式,你可以使用類似:

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

現在,如果你的伽瑪爲1,縮放是線性的。當gamma> 1時,最後幾個單元的強度會增加得更快。當它小於1時,它會在前幾個單元格中快速變化。

我假設在上面的cellNum去從1到20,那numCells爲20的對比度此值,在您使用的.TintAndShade表達,應該給你你正在尋找的效果。 gamma不需要是一個整數,但如果它是< 0,你會得到對比度> 1,那會給你奇怪的結果(全白,我想象)。

順便說一句 - 重命名macro3的東西更明智的(adjustContrast),並與F5的值作爲參數調用它:

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 

因爲很明顯從你的評論中我原來的發帖內容不夠明確,下面是完整的代碼以及它給我的結果。請注意 - 這是代碼來演示顯示,不是你想用確切的代碼上改變伽瑪的影響(例如,我遍歷四列,並有伽馬的四種不同的值):

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 

之前我運行代碼,我的屏幕看起來像這樣(在細胞中的值是給定的伽馬計算的對比度值):

enter image description here

它運行後,它看起來像這樣:

enter image description here

正如你所看到的,我添加了一個額外的「功能」:改變字體的顏色以保持可見。當然,這假定「模板單元格」(在我的例子中爲A1)在字體和填充顏色之間具有良好的對比度。

+0

我只是誇大了兩倍,只是爲了表達我的觀點,並且更清楚地描述它。我直覺地知道在我的「對比」公式中應該有一些'^'指數。但是,我無法弄清楚我應該如何糾正我的代碼。我按照你的建議嘗試了'gamma',但沒有得到任何積極的結果。你能否用任何測試函數糾正我的代碼,以便它能正常工作? – Buras 2013-04-29 06:15:56

+0

@ Buras - 我已經用一個完整的工作宏和一些屏幕截圖擴展了我的答案,以便您可以看到究竟發生了什麼。 – Floris 2013-04-29 14:44:20

+0

謝謝。非常詳細的答案 – Buras 2013-04-29 20:45:27

4

有它的工作指數,你可以嘗試使用一種與結果如下邏輯:

enter image description here

下面的代碼稍有改變相比,你一個:

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 

什麼是重要的 - 看看這條線:

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

你可以做任何你想做的事情,例如。將(1 + (c/allCellsCount))更改爲1至2之間的內容以瞭解邏輯的方式。通常,您可以調整陰影更改操縱此線的速度,尤其是使用此部分代碼進行操作:(c * (1 + (c/allCellsCount))

+0

謝謝@KazJaw – Buras 2013-04-29 06:23:31