用于特定条件格式的VBA代码，根据另一个范围的值调整条长度[excel VBA]

Question

我想要一个 VBA 代码来创建数据栏，但数据栏的长度基于另一个范围中的值，同时向我显示每个单元格中当前范围的值。

为了澄清，想象一些单元格的值 groupA=[1,2,-1,3,5,-2,-4] 而其他一些单元格的值 groupB=[5,-1,2,3,- 1,2,1]。我在这里想要的是根据 groupB 的值在范围 groupA 上创建一些条形图，同时我看到 groupA 的初始值。

这样我就可以了解A组的值对我的结果的影响并调整我的参数。

到目前为止，我设法编写了代码的基础知识，不幸的是我没有成功地添加修改。如果有人可以帮助我修改这段代码，那么这对我来说是一个很大的帮助。

Sub databars()
Dim rg As Range
Dim db As Databar


Set rg = Range("A1", Range("A1").End(xlDown))
rg.FormatConditions.Delete
Set db = rg.FormatConditions.AddDatabar


With db
    'positive bar formatted with black gradient & black border
    .BarColor.color = RGB(0, 0, 255)
    .BarFillType = xlDataBarFillGradient
    .BarBorder.Type = xlDataBarFillGradient
    .BarBorder.color.color = vbBlack
    'the axis positioned automatically and coloured red
    .AxisPosition = xlDataBarAxisAutomatic
    .AxisColor.color = vbRed
    'the negative bar formatted with a red gradient and red border
    With .NegativeBarFormat
        .ColorType = xlDataBarColor
        .color.color = vbRed
        .BorderColorType = xlDataBarColor
        .BorderColor.color = vbRed
    End With
End With
End Sub

ChatGPT，认为这是可能的，但不幸的是，它建议的代码存在一些我无法解决的错误。我会把它的建议写在这里，也许能有点帮助。

'Sub ApplyDataBarsWithValuesFromGroupB()
Dim groupA As Range
Dim groupB As Range
Dim cellA As Range
Dim cellB As Range
Dim maxValueB As Double
Dim scaleFactor As Double
Dim dataBarRule As Databar

' Set the ranges for Group A and Group B
Set groupA = Range("A1:A7")
Set groupB = Range("B1:B7")

' Determine the maximum value in Group B
maxValueB = Application.WorksheetFunction.Max(groupB)

' Calculate the scaling factor for data bars
scaleFactor = 100 ' Adjust this factor as needed

' Apply data bars to Group A based on values from Group B
For Each cellA In groupA
    ' Get the corresponding value from Group B
    Set cellB = groupB.Cells(cellA.Row, 1)
    
    ' Calculate the scaled value for data bars
    Dim scaledValue As Double
    scaledValue = (cellB.Value / maxValueB) * scaleFactor
    
    ' Apply conditional formatting using scaled values
    Set dataBarRule = cellA.FormatConditions.AddDatabar
    dataBarRule.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
    dataBarRule.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
    dataBarRule.DataBar.PercentMin = 0
    dataBarRule.DataBar.PercentMax = scaledValue
    
    ' Show the original value in the cell as text
    cellA.Value = cellA.Value & " (" & cellB.Value & ")"
Next cellA

结束子'

Answer 1

根据其他评论，您无法使用 CF 执行此操作，但您可以使用图表来模拟它。更好的是，这不需要 VBA。这是结果的示例：

如果它适合您，以下是创建它的步骤（您只需为所有 7 行执行一次，而不是每行一次）：

• 选择包含源数据的范围（在您的情况下为“groupB”）
• 添加图表 - “二维条形图”（簇状条形图）
• 选择“垂直（类别）轴”
• 在“轴选项”中，选择“相反顺序的类别”（假设在您的设备上，就像在我的设备上一样，每个栏最初的顺序是错误的）
• 然后按删除键从图表中删除垂直轴
• 您可以选择水平（值）轴，然后在“轴选项”中设置最小和最大界限（或保留为自动）
• 然后，依次选择并删除：图表标题、水平（值）轴、水平轴网格线
• 选择“绘图区域”并使用 4 个拖动手柄（一个接一个）拉伸绘图区域以填充“图表区域”
• 选择“图表区域”，在“填充”中选择“不填充”
• 选择“系列”（应该只有 1 个），然后在“系列选项”中，将“间隙宽度”更改为 0%
• 仍然选择“系列”，在“填充”中选择“实心填充”并将“透明度”调整为 30%
• 在“groupA”单元格上拖动图表并调整其大小...如果您首先选择“对齐网格”，这会更容易：在 Excel 功能区的“页面布局”选项卡中：对齐 > 对齐网格

显然，您可以像调整任何其他图表一样调整颜色、透明度、大小等。