根据单元格 vba 的特性创建动态范围

Question

我想比较两个非粗体或单元格内部颜色为空的单元格的总和。我想比较只有当列的标签是“miercoles”、“jueves”、“viernes”或“sabado”时列的单元格值的总和，并且只是在咨询四列后着色最大的结果对于第一个标签 1、2、3 和 4。 我已经编写了这段代码，但我没有在变量 g 中保存任何范围。 如何创建动态范围 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