我不知道为什么VBA不断回复我的消息"循环没有做"对于以下结构。
错误与最后一个"循环"有关,应该与第一个相关 Do Until(Do Until Cells(j,9)<>"")
Ps:我们的想法是拥有一个可以提供工作表成本的表单,我们可以在其中找到开始日期,结束日期,课程类型和团队成员名称。 然后,根据课程类型,它应该转到另一个工作表(天),在那里您将找到按日期划分的日历。 Excel应该找到正确的开始和结束日期,然后找到正确的团队成员名称,然后根据课程类型,它应该在不同颜色的开始日期和结束日期之间绘制单元格。
有人可以帮助我吗?
Sub days()
Sheets("Costs").Activate
j = 2
Do Until Cells(j, 9) = ""
Dim mes_startdate As Integer
mes_startdate = Mid(Cells(j, 9), 4, 2)
Dim mes_enddate As Integer
mes_enddate = Mid(Cells(j, 10), 4, 2)
Dim startdate As Date
startdate = Cells(j, 9).Value
Dim enddate As Date
enddate = Cells(j, 10).Value
Dim teammember As String
teammember = Cells(j, 2).Value
Dim coursetype As String
coursetype = Cells(j, 4).Value
Sheets("Days").Activate
Dim celula1_linha_startdate As Integer
If mes_startdate = "01" Then
celula1_linha_startdate = Range("B10").Row
Else
If mes_startdate = "02" Then
celula1_linha_startdate = Range("B31").Row
Else
If mes_startdate = "03" Then
celula1_linha_startdate = Range("B52").Row
Else
If mes_startdate = "04" Then
celula1_linha_startdate = Range("B73").Row
Else
If mes_startdate = "05" Then
celula1_linha_startdate = Range("B93").Row
Else
If mes_startdate = "06" Then
celula1_linha_startdate = Range("B113").Row
Else
If mes_startdate = "07" Then
celula1_linha_startdate = Range("B133").Row
Else
If mes_startdate = "08" Then
celula1_linha_startdate = Range("B153").Row
Else
If mes_startdate = "09" Then
celula1_linha_startdate = Range("B173").Row
Else
If mes_startdate = "10" Then
celula1_linha_startdate = Range("B173").Row
Else
If mes_startdate = "11" Then
celula1_linha_startdate = Range("B193").Row
Else
If mes_startdate = "12" Then
celula1_linha_startdate = Range("B213").Row
Else
End If
If mes_enddate = "01" Then
celula1_linha_enddate = Range("B10").Row
Else
If mes_enddate = "02" Then
celula1_linha_enddate = Range("B31").Row
Else
If mes_enddate = "03" Then
celula1_linha_enddate = Range("B52").Row
Else
If mes_enddate = "04" Then
celula1_linha_enddate = Range("B73").Row
Else
If mes_enddate = "05" Then
celula1_linha_enddate = Range("B93").Row
Else
If mes_enddate = "06" Then
celula1_linha_enddate = Range("B113").Row
Else
If mes_enddate = "07" Then
celula1_linha_enddate = Range("B133").Row
Else
If mes_enddate = "08" Then
celula1_linha_enddate = Range("B153").Row
Else
If mes_enddate = "09" Then
celula1_linha_enddate = Range("B173").Row
Else
If mes_enddate = "10" Then
celula1_linha_enddate = Range("B173").Row
Else
If mes_enddate = "11" Then
celula1_linha_enddate = Range("B193").Row
Else
If mes_enddate = "12" Then
celula1_linha_enddate = Range("B213").Row
Else
End If
nome_linha = celula1_linha_startdate + 2
Do Until Cells(nome_linha, 1).Value = teammember
nome_linha = celula1_linha_startdate + 1
Loop
startdate_coluna = 2
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = startdate
startdate_coluna = startdate_coluna + 1
Loop
enddate_coluna = 2
Do Until Cells(celula1_linha_enddate, enddate_coluna).Value = enddate
enddate_coluna = enddate_coluna + 1
Loop
If mes_startdate = mes_enddate Then
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = Cells(celula1_linha_enddate, enddate_coluna).Value
If coursetype = "E-learning" Then
Cells(nome_linha, startdate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "International Courses" Then
Cells(nome_linha, startdate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, startdate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, startdate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "Other Courses" Then
Cells(nome_linha, startdate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
'Nothing should happen
End If
startdate_coluna = startdate_coluna + 1
Loop
Else
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = Cells(celula1_linha_startdate, 32).Value
If coursetype = "E-learning" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "International Courses" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "Other Courses" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
'Nothing should happen
End If
startdate_coluna = startdate_coluna + 1
Loop
Do Until Cells(celula1_linha_enddate, enddate_coluna).Value = Cells(celula1_linha_enddate, 1).Value
If coursetype = "E-learning" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "International Courses" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If coursetype = "Other Courses" Then
Cells(nome_linha, enddate_coluna).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
'Nothing should happen
End If
enddate_coluna = enddate_coluna - 1
Loop
End If
j = j + 1
Loop
End Sub
答案 0 :(得分:3)
将Option Explicit
放在模块的开头,将所有声明(Dim
)移到子程序的顶部(循环外)。您可以通过在同一行上放置类似的声明来节省一些空间,就像我在这里一样。
您需要使用Select Case
,ElseIf
和数组。我只需经过两次Select Case
两次即可获得mes_startdate
和mes_enddate
所需的值。另外需要注意的是 - 并非所有If
语句都需要Else
。如果Else
没有任何理由,请完全排除它!
更改单元格的Interior.Color
时,您可以通过仅更改颜色作弊,并省略其他详细信息(如果他们不是改变)。这能够减少很多混乱。 请注意我是如何通过明确引用单元格来摆脱Select
的!
我在这里清理了其他一些东西,但我只是说你应该自己比较并寻找这些变化。我实际上不知道你在这里想要完成什么,所以这可能不会工作但是它的格式正确,可以从这里向前推进。
Option Explicit
Sub days()
Dim i As Long, j As Long
Dim mes_startdate As Integer, mes_enddate As Integer
Dim startdate As Date, enddate As Date
Dim teammember As String, coursetype As String
Dim celula1_linha_startdate As Integer, celula1_linha_enddate As Integer
Dim nome_linha As Integer
Dim startdate_coluna As Integer, enddate_coluna As Integer
Dim myarray As Variant
myarray = Array(mes_startdate, mes_enddate)
Sheets("Costs").Activate
j = 2
Do Until Cells(j, 9) = ""
mes_startdate = Mid(Cells(j, 9), 4, 2)
mes_enddate = Mid(Cells(j, 10), 4, 2)
startdate = Cells(j, 9).Value
enddate = Cells(j, 10).Value
teammember = Cells(j, 2).Value
coursetype = Cells(j, 4).Value
Sheets("Days").Activate
For i = 0 To UBound(myarray)
Select Case myarray(i)
Case "01"
celula1_linha_startdate = Range("B10").Row
Case "02"
celula1_linha_startdate = Range("B31").Row
Case "03"
celula1_linha_startdate = Range("B52").Row
Case "04"
celula1_linha_startdate = Range("B73").Row
Case "05"
celula1_linha_startdate = Range("B93").Row
Case "06"
celula1_linha_startdate = Range("B113").Row
Case "07"
celula1_linha_startdate = Range("B133").Row
Case "08"
celula1_linha_startdate = Range("B153").Row
Case "09"
celula1_linha_startdate = Range("B173").Row
Case "10"
celula1_linha_startdate = Range("B173").Row
Case "11"
celula1_linha_startdate = Range("B193").Row
Case "12"
celula1_linha_startdate = Range("B213").Row
End Select
Next i
nome_linha = celula1_linha_startdate + 2
Do Until Cells(nome_linha, 1).Value = teammember
nome_linha = celula1_linha_startdate + 1
Loop
startdate_coluna = 2
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = startdate
startdate_coluna = startdate_coluna + 1
Loop
enddate_coluna = 2
Do Until Cells(celula1_linha_enddate, enddate_coluna).Value = enddate
enddate_coluna = enddate_coluna + 1
Loop
If mes_startdate = mes_enddate Then
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = Cells(celula1_linha_enddate, enddate_coluna).Value
If coursetype = "E-learning" Then
Cells(nome_linha, startdate_coluna).Interior.ThemeColor = xlThemeColorAccent6
ElseIf coursetype = "International Courses" Then
Cells(nome_linha, startdate_coluna).Interior.Color = 10498160
ElseIf coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, startdate_coluna).Interior.Color = 49407
ElseIf coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, startdate_coluna).Interior.Color = 12611584
ElseIf coursetype = "Other Courses" Then
Cells(nome_linha, startdate_coluna).Interior.Color = 192
End If
startdate_coluna = startdate_coluna + 1
Loop
Else
Do Until Cells(celula1_linha_startdate, startdate_coluna).Value = Cells(celula1_linha_startdate, 32).Value
If coursetype = "E-learning" Then
Cells(nome_linha, enddate_coluna).Interior.ThemeColor = xlThemeColorAccent6
ElseIf coursetype = "International Courses" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 10498160
ElseIf coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 49407
ElseIf coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 12611584
ElseIf coursetype = "Other Courses" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 192
End If
startdate_coluna = startdate_coluna + 1
Loop
Do Until Cells(celula1_linha_enddate, enddate_coluna).Value = Cells(celula1_linha_enddate, 1).Value
If coursetype = "E-learning" Then
Cells(nome_linha, enddate_coluna).Interior.ThemeColor = xlThemeColorAccent6
ElseIf coursetype = "International Courses" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 10498160
ElseIf coursetype = "National Courses Inside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 49407
ElseIf coursetype = "National Courses Outside Rio de Janeiro" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 12611584
ElseIf coursetype = "Other Courses" Then
Cells(nome_linha, enddate_coluna).Interior.Color = 192
End If
enddate_coluna = enddate_coluna - 1
Loop
End If
j = j + 1
Loop
End Sub
编辑我把它放在Mat的Rubberduck Indenter中,因为我可以看到它有点遍布整个地方,我自己也不想修复它所以我使用了这个伟大的工具! :)