Sheet1 上单元格中的值更改 Sheet2 上单元格中的颜色渐变

Question

一段时间以来，我一直在尝试自己拼凑这段代码，但无法让它工作。 基本上我想要做的是在 Sheet1 上有一个值表，我在其中输入 1、1.1、1.2、... 到 5，并且每个单元格中的每个值对应于在 Sheet2 上的特定单元格中创建颜色渐变。

例如，如果在 Sheet1 B12 中输入“1.1”，我希望 Sheet2 B13 使用特定的颜色渐变进行着色，该渐变与 Sheet1 B12 包含“1.2”的情况略有不同，并且此渐变将在 1 和 5 之间变化.

到目前为止，我想我已经弄清楚了如何使用 With 和 Case 语句根据另一个单元格的值用渐变填充一个单元格。但是，我不知道如何使代码在工作表之间工作并自动运行，因为 Sheet1 上的单元格值发生变化，Sheet2 上的颜色发生变化。

Private Sub Heatmap()

    If Not Intersect(Target, Range("B13")) Is Nothing Then
            Select Case Range("B13").Value
              Case 1.1
    With Sheets("Sheet2").Range("B12").Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 180
        .Gradient.ColorStops.Clear
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0)
        .Color = RGB(0, 176, 0)
        .TintAndShade = 0
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0.7)
        .Color = RGB(0, 176, 80)
        .TintAndShade = 0
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(1)
        .Color = RGB(255, 255, 255)
        .TintAndShade = 0
    End With
            Case 1.2
    With Sheets("Sheet2").Range("B12").Interior.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 180
        .Gradient.ColorStops.Clear
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0)
        .Color = RGB(0, 176, 80)
        .TintAndShade = 0
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0.3)
        .Color = RGB(0, 176, 80)
        .TintAndShade = 0
    End With
    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(1)
        .Color = RGB(255, 255, 0)
        .TintAndShade = 0
    End With
End Select
End If
End Sub

我还没有解决两个案例，所以我最终不会编写数百行代码并且它不起作用。一旦我知道它适用于这两种情况，我就可以一遍又一遍地复制它并按照我想要的方式开发渐变，这样 Sheet2 上的每个单元格都会根据 Sheet1 上相应单元格的值具有特定的渐变。

感谢您的帮助！

Answer 1

将代码粘贴到Sheet1 而不是任何Module 或Thisworkbook

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B13")) Is Nothing Then

            Select Case Range("B13").Value

            Case 1.1

                    With Sheets("Sheet2").Range("B12").Interior
                        .Pattern = xlPatternLinearGradient
                        .Gradient.Degree = 180
                        .Gradient.ColorStops.Clear
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0)
                        .Color = RGB(0, 176, 0)
                        .TintAndShade = 0
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0.7)
                        .Color = RGB(0, 176, 80)
                        .TintAndShade = 0
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(1)
                        .Color = RGB(255, 255, 255)
                        .TintAndShade = 0
                    End With
            Case 1.2

                    With Sheets("Sheet2").Range("B12").Interior.Interior
                        .Pattern = xlPatternLinearGradient
                        .Gradient.Degree = 180
                        .Gradient.ColorStops.Clear
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0)
                        .Color = RGB(0, 176, 80)
                        .TintAndShade = 0
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(0.3)
                        .Color = RGB(0, 176, 80)
                        .TintAndShade = 0
                    End With

                    With Sheets("Sheet2").Range("B12").Interior.Interior.Gradient.ColorStops.Add(1)
                        .Color = RGB(255, 255, 0)
                        .TintAndShade = 0
                        End With
            End Select
    End If

End Sub

假设您的代码工作正常，这将使其在 sheet1 上的值发生变化时自动运行。