我想比较两个单元格的总和,这两个单元格不是粗体字体,或者单元格内部的颜色是空的。我想比较列的单元格值的总和,只有当列的标签是" 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
答案 0 :(得分:0)
如果有人需要做类似的事情,这就是我解决问题的方法
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