Question

代码似乎运行顺利，我现在只是计算了总和和颜色的输出问题，我正在尝试将输出打印到“SC”工作表，以便进一步分析。因此，新工作表中的输出应构建一个矩阵，其中包含无关值（sum或value＆lt; 1）0以及相应单元格中显示的总和值。

Private Sub MC()
    Dim c&, i&, j&
    Worksheets("SC").Cells.Clear
    For j = 1 To Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
            If Worksheets("Data").Cells(i, j) > 0 Then
                c = RGB(Int(Rnd * 255) + 1, Int(Rnd * 255) + 1, Int(Rnd * 255) + 1)
               'Debug.Print "Testing value at: " & Cells(i, j).Address & vbLf & "Cone sum: " & SumAndColorCone(Cells(i, j), c) & vbLf
               Worksheets("SC").Cells(i, j) = "Testing value at: " & Cells(i, j).Address & vbLf & "Cone sum: " & SumAndColorCone(Cells(i, j), c) & vbLf

            Else: If Worksheets("Data").Cells(i, j) <= "0" Then Worksheets("SC").Cells(i, j) = "0"

            End If

        Next
    Next
End Sub

Private Function SumAndColorCone(r As Range, color&) As Double
    Dim i&, k&, c As Range
    Set c = r
    For i = r.Row - 1 To 1 Step -1
        If r.Column - k < 2 Then
            Set c = Union(c, r(-k, -r.Column + 2).Resize(, r.Column + k + 1))
        Else
            Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
        End If
        k = k + 1
    Next
    SumAndColorCone = Application.Sum(c)
    If SumAndColorCone > 1 Then c.Interior.color = color
    'If value of sum is less than 1 return "0"
    If SumAndColorCone < 1 Then SumAndColorCone = "0"
End Function

Answer 1

试试这个：

Private Sub MC()
    Dim c&, i&, j&
    Worksheets("SC").Cells.Clear
    For j = 1 To Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
            If Worksheets("Data").Cells(i, j) > 0 Then
                c = RGB(Int(Rnd * 255) + 1, Int(Rnd * 255) + 1, Int(Rnd * 255) + 1)
                Worksheets("SC").Cells(i, j) = SumAndColorCone(Worksheets("Data").Cells(i, j), c, Worksheets("SC"))
            Else
                If Worksheets("Data").Cells(i, j) <= "0" Then Worksheets("SC").Cells(i, j) = "0"
            End If
        Next
    Next
End Sub

Private Function SumAndColorCone(r As Range, Color&, wsColor As Worksheet) As Double
    Dim i&, k&, c As Range
    Set c = r
    For i = r.Row - 1 To 1 Step -1
        If r.Column - k < 2 Then
            Set c = Union(c, r(-k, -r.Column + 2).Resize(, r.Column + k + 1))
        Else
            Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
        End If
        k = k + 1
    Next
    SumAndColorCone = Application.Sum(c)
    If SumAndColorCone >= 1 Then
        wsColor.Range(c.Address).Interior.Color = Color
    Else
        SumAndColorCone = 0
    End If
End Function

可变总和的单元输出

1 个答案: