根据单元格vba的特性创build一个dynamic范围

我想比较两个不是粗体的单元格的总和，或者单元格内部的颜色是空的。 我想比较列的单元格的值的总和，只有当列的标签是“miercoles”，“jueves”，“viernes”或“sabado”，并且在查阅四列后才着色最大的结果对于第一个标签1,2,3和4.我做了这个代码，但我没有在variablesg中保存任何范围。 我如何创builddynamic范围g？

Sub reuniones_dos_horas() Dim r As Range Dim r2 As Range a = 2 While Sheets("Dinamicos").Cells(27, a) <> "" b = 1 While Sheets("Dinamicos").Cells(27, a) <= b + 3 c = 2 While Sheets("Dinamicos").Cells(29, c) <> "" Drev = Sheets("Dinamicos").Cells(29, c) If Sheets("Dinamicos").Cells(29, c) = "Miercoles" Or Sheets("Dinamicos").Cells(29, c) = "Jueves" Or Sheets("Dinamicos").Cells(29, c) = "Viernes " Or Sheets("Dinamicos").Cells(29, c) = "Sabado" Then d = 30 While Sheets("Dinamicos").Cells(d + 1, c) <> "" If Sheets("Dinamicos").Cells(d + 1, c).Interior.Pattern = xlNone And Sheets("Dinamicos").Cells(d, c).Interior.Pattern = xlNone And Sheets("Dinamicos").Cells(d + 1, c).Font.Bold = False And Sheets("Dinamicos").Cells(d, c).Font.Bold = False Then e = Application.Sum(Sheets("Dinamicos").Cells(d + 1, c), Sheets("Dinamicos").Cells(d, c)) f = Application.Sum(Sheets("Dinamicos").Cells(d + 1, c), Sheets("Dinamicos").Cells(d + 2, c)) If e >= f Then e_range1 = Sheets("Dinamicos").Range(Cells(d, c), Cells(d + 1, c)).Select ElseIf f > e Then f_range1 = Sheets("Dinamicos").Range(Cells(d + 1, c), Cells(d + 2, c)).Select End If For Each r2 In Range(Cells(30, c), Cells(44, c)) If r2.Font.Underline = True Then If r Is Nothing Then Set r = Range(Cells(r2.Row, c)) Else Set r = Union(r, Range(Cells(r2.Row, c))) End If End If Next h = WorksheetFunction.Sum(ActiveRange) g = WorksheetFunction.Sum(r) If h >= g Then Range(List).Activate Range(List).Font.Underline = True ElseIf g > h Then ActiveRange.Select ActiceRange.Font.Underline = True Range(List).Font.Underline = False End If End If d = d + 1 Wend End If c = c + 1 Wend b = b + 1 Wend a = a + 1 Wend End Sub 

Answer 1

如果有人需要做类似的事情，这是我如何解决我的问题

  Sub reuniones_dos_horas() Dim r As Range Dim r2 As Range Dim range1 As Range Dim ra As Range Dim W As Integer Dim W0 As Integer Dim ran As Range Sheets("Dinamicos").Range("B30:LG44").Font.Underline = False c = 2 While Sheets("Dinamicos").Cells(29, c) <> "" Drev = Sheets("Dinamicos").Cells(29, c) If Sheets("Dinamicos").Cells(29, c) = "Miercoles" Or Sheets("Dinamicos").Cells(29, c) = "Jueves" Or Sheets("Dinamicos").Cells(29, c) = "Viernes " Or Sheets("Dinamicos").Cells(29, c) = "Sabado" Then d = 30 While Sheets("Dinamicos").Cells(d + 1, c) <> "" If Sheets("Dinamicos").Cells(d + 1, c).Interior.ColorIndex = xlNone And Sheets("Dinamicos").Cells(d, c).Interior.ColorIndex = xlNone And Sheets("Dinamicos").Cells(d + 1, c).Font.Bold = False And Sheets("Dinamicos").Cells(d, c).Font.Bold = False Then e = Application.Sum(Sheets("Dinamicos").Cells(d + 1, c), Sheets("Dinamicos").Cells(d, c)) f = Application.Sum(Sheets("Dinamicos").Cells(d + 1, c), Sheets("Dinamicos").Cells(d + 2, c)) If Sheets("Dinamicos").Cells(d, c).Interior.ColorIndex = xlNone And Sheets("Dinamicos").Cells(d + 1, c).Interior.ColorIndex = xlNone And Sheets("Dinamicos").Cells(d + 2, c).Interior.ColorIndex = xlNone Then If e >= f Then Set range1 = Union(Sheets("Dinamicos").Cells(d, c), Sheets("Dinamicos").Cells(d + 1, c)) ElseIf f > e Then Set range1 = Union(Sheets("Dinamicos").Cells(d + 1, c), Sheets("Dinamicos").Cells(d + 2, c)) End If For Each r2 In Range(Cells(30, c), Cells(44, c)) ver = r2.Row ver2 = Cells(r2.Row, c) If r2.Interior.ColorIndex = xlNone Then If r2.Font.Underline = xlUnderlineStyleSingle Then If r Is Nothing Then Set r = Cells(r2.Row, c) Else Set r = Union(r, Cells(r2.Row, c)) End If End If End If Next g = WorksheetFunction.Sum(range1) If r Is Nothing Then h = g Else h = WorksheetFunction.Sum(r) End If If h >= g And r Is Nothing Then range1.Font.Underline = True Cells(47, c) = g ElseIf h >= g Then range1.Font.Underline = False r.Font.Underline = True Cells(47, c) = h ElseIf g > h Then r.Font.Underline = False range1.Font.Underline = True Cells(47, c) = g End If Set r = Nothing End If End If d = d + 1 Wend End If c = c + 1 Wend a1 = 1 b1 = 2 For a1 = 1 To 56 Step 4 'While a1 <= 50 While Sheets("Dinamicos").Cells(27, b1) < a1 + 3 And Sheets("Dinamicos").Cells(27, b1) <> "" If a1 > 50 Then Exit Sub Else W0 = Application.WorksheetFunction.CountIf(Range("B27:LG27"), "<" & a1) W = Application.WorksheetFunction.CountIf(Range("B27:LG27"), "<=" & a1 + 3) X = W - W0 y = X - 23 Y1 = y + 1 Y2 = 1 + W - 23 YY = Sheets("Dinamicos").Cells(47, 1 + W) XX = Sheets("Dinamicos").Cells(47, Y1) Set ra = Range(Cells(47, Y2), Cells(47, 1 + W)) AddressOfMax(ra).Interior.Color = RGB(0, 102, 204) col = AddressOfMax(ra).Column For Each rb In Range(Cells(30, col), Cells(44, col)) ver = rb.Row ver2 = Cells(rb.Row, col) If rb.Font.Underline = xlUnderlineStyleSingle Then If ran Is Nothing Then Set ran = Cells(rb.Row, col) Else Set ran = Union(ran, Cells(rb.Row, col)) End If End If Next ran.Interior.Color = RGB(0, 102, 204) b1 = b1 + 1 End If Wend b1 = 2 Next a1 'a1 = a1 + 4 'Wend Call formato2 End Sub