Вывод соты для переменной суммы

Question

Код работает нормально, теперь у меня проблема с выводом суммы и цвета после его вычисления. Я пытаюсь распечатать выходы на листе «SC», поэтому они могут быть дополнительно проанализированы. Таким образом, выход на новом рабочем листе должен построить матрицу с нерелевантными значениями (сумма или значение < 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