Excel VBA 代码读取一些行并丢弃其他行
Excel VBA code reads some rows and discards others
这是我第一次在这里提问。
所以这是我的问题：
我有一个相当大的 vba 代码，但我会给你一个简短的摘要。
我有一个 sheet，其中包含有关课程的信息，例如：课程代码、主题、教授、日期、btime、etime 等...
和另一个 sheet 有我正在寻找的课程来创建一个时间表。
所以代码将读取两个 sheet 并比较它们，然后在另一个 sheet 上输出数据。问题是，如果假设一门课程有 2 个讲座、3 个教程和 2 个实验（在不同的时间和日期），它只会读一些而剩下的
这是我的主要代码：
Sub Schedule()
Row = 1
T8 = 1
T9 = 1
T10 = 1
T11 = 1
T12 = 1
T13 = 1
T14 = 1
T15 = 1
T16 = 1
T17 = 1
T18 = 1
lRow = Worksheets("Banner Summary").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Schedule").Range("B8:AZ100").ClearContents
Worksheets("Schedule").Cells.Interior.Color = xlNone
Worksheets("Schedule").Activate
For x = 2 To 7
For i = 2 To lRow
word = Worksheets("Program Map").Cells(5, x)
PSub = Left(word, 4)
PCode = Trim(PSub)
pcourse = Mid(word, 5, 6)
f = InStr(pcourse, "U")
PCode1 = Left(pcourse, f)
day = Sheets("Banner Summary").Cells(i, 15).Text
bTime = Sheets("Banner Summary").Cells(i, 16).Text
eTime = Sheets("Banner Summary").Cells(i, 17).Text
Subject = Sheets("Banner Summary").Cells(i, 2).Text
Course = Sheets("Banner Summary").Cells(i, 3).Text
Title = Sheets("Banner Summary").Cells(i, 4).Text
Section = Sheets("Banner Summary").Cells(i, 5).Text
CRN = Sheets("Banner Summary").Cells(i, 6).Text
ClassType = Sheets("Banner Summary").Cells(i, 9).Text
Room = Sheets("Banner Summary").Cells(i, 18).Text
Prof = Sheets("Banner Summary").Cells(i, 20).Text
BSubject = Worksheets("Banner Summary").Cells(i, 2)
BCourse = Worksheets("Banner Summary").Cells(i, 3)
BCode = BSubject & " " & BCourse
info = Prof & "-" & Subject & " " & Course & "-" & vbNewLine & Title & vbNewLine & CRN & "-" & ClassType & "-" & Section & vbNewLine & Room & ":" & bTime & "-" & eTime
RColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))
fcourse1 = PCode & PCode1
BCourse1 = Subject & Course
fcourse = Left(word, 10)
BCourse = Subject & " " & Course
result = StrComp(fcourse, BCourse)
result1 = StrComp(fcourse1, BCourse1)
If result = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
ElseIf result1 = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
End If
Next i
Next x
End Sub
只是一个简短的解释，案例是天数，(5, x) 是程序映射中我试图获取时间表的行。
下面是仅处理一天和一次时段的数据的方式：
Sub caseM(i As Variant)
day = Sheets("Banner Summary").Cells(i, 15).Text
bTime = Sheets("Banner Summary").Cells(i, 16).Text
eTime = Sheets("Banner Summary").Cells(i, 17).Text
Subject = Sheets("Banner Summary").Cells(i, 2).Text
Course = Sheets("Banner Summary").Cells(i, 3).Text
Title = Sheets("Banner Summary").Cells(i, 4).Text
Section = Sheets("Banner Summary").Cells(i, 5).Text
CRN = Sheets("Banner Summary").Cells(i, 6).Text
ClassType = Sheets("Banner Summary").Cells(i, 9).Text
Room = Sheets("Banner Summary").Cells(i, 18).Text
Prof = Sheets("Banner Summary").Cells(i, 20).Text
BSubject = Worksheets("Banner Summary").Cells(i, 2)
BCourse = Worksheets("Banner Summary").Cells(i, 3)
BCode = BSubject & " " & BCourse
info = Prof & "-" & Subject & " " & Course & "-" & vbNewLine & Title & vbNewLine & CRN & "-" & ClassType & "-" & Section & vbNewLine & Room & ":" & bTime & "-" & eTime
RColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))
Select Case bTime
Case "0810"
If eTime = "0900" Then
If T8 = 1 Then
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("B8").Value = info
Sheets("Schedule").Range("B8:B12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 2 Then
If Cells(8, 3) = RGB(0, 0, 0) And Cells(12, 3) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("C8").Value = info
Sheets("Schedule").Range("C8:C12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 3 Then
If Cells(8, 4) = RGB(0, 0, 0) And Cells(12, 4) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("D8").Value = info
Sheets("Schedule").Range("D8:D12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 4 Then
If Cells(8, 5) = RGB(0, 0, 0) And Cells(12, 5) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("E8").Value = info
Sheets("Schedule").Range("E8:E12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 5 Then
If Cells(8, 6) = RGB(0, 0, 0) And Cells(12, 6) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 6 Then
If Cells(8, 7) = RGB(0, 0, 0) And Cells(12, 7) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("G8").Value = info
Sheets("Schedule").Range("G8:G12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 7 Then
If Cells(8, 8) = RGB(0, 0, 0) And Cells(12, 8) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 8 Then
If Cells(8, 9) = RGB(0, 0, 0) And Cells(12, 9) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
End If
这是如何工作的，对于某个 btime，它将通过检查单元格的颜色来检查该时间和日期所需的单元格是否为空。由于某种原因，即使单元格没有颜色，它仍然会跳过它并继续下一个。
我知道这很长，但我已经和这件事抗争了一个多月了，真的需要一些帮助。提前感谢任何这样做的人。
我在你的代码中发现的问题是这部分
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
单元格将获取指定单元格的值。你正在将它与 RGB(0, 0, 0)
进行比较
除非您的单元格为空或 0
，否则这将始终为假
(RGB(0, 0, 0) 值为0，当单元格为空时，VBA会认为是0)
如果要对比实际颜色，需要放
Cells(8, 2).Interior.Color = RGB(0, 0, 0)
Cells(8, 2).Font.Color = RGB(0, 0, 0)
另外，代码越短，越容易排错
下面部分
If result = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
ElseIf result1 = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
End If
由于您正在执行完全相同的程序，因此可以将其写为
If result = 0 or result1 = 0Then
Select Case day
Case "M": Call caseM(i)
Case "T": Call caseT(i)
Case "W": Call caseW(i)
Case "R": Call caseR(i)
Case "F": Call caseF(i)
End Select
End If
注意：":"" 表示在 ":" 之后将被视为下一行
还有下面的部分
If T8 = 1 Then
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("B8").Value = info
Sheets("Schedule").Range("B8:B12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 2 Then
If Cells(8, 3) = RGB(0, 0, 0) And Cells(12, 3) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("C8").Value = info
Sheets("Schedule").Range("C8:C12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
...........
可以改写为
If Cells(8, T8 + 1).Interior.Color = RGB(0, 0, 0) And Cells(12, T8 + 1).Interior.Color = RGB(0, 0, 0,) Then
Sheets("Schedule").Cells(8, T8 + 1).Value = info
Sheets("Schedule").Range(Cells(8, T8 + 1),Cells(12, T8 + 1)).Interior.Color = RColor
End if
T8 = T8 + 1
这是我第一次在这里提问。 所以这是我的问题： 我有一个相当大的 vba 代码，但我会给你一个简短的摘要。
我有一个 sheet，其中包含有关课程的信息，例如：课程代码、主题、教授、日期、btime、etime 等... 和另一个 sheet 有我正在寻找的课程来创建一个时间表。
所以代码将读取两个 sheet 并比较它们，然后在另一个 sheet 上输出数据。问题是，如果假设一门课程有 2 个讲座、3 个教程和 2 个实验（在不同的时间和日期），它只会读一些而剩下的
这是我的主要代码：
Sub Schedule()
Row = 1
T8 = 1
T9 = 1
T10 = 1
T11 = 1
T12 = 1
T13 = 1
T14 = 1
T15 = 1
T16 = 1
T17 = 1
T18 = 1
lRow = Worksheets("Banner Summary").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Schedule").Range("B8:AZ100").ClearContents
Worksheets("Schedule").Cells.Interior.Color = xlNone
Worksheets("Schedule").Activate
For x = 2 To 7
For i = 2 To lRow
word = Worksheets("Program Map").Cells(5, x)
PSub = Left(word, 4)
PCode = Trim(PSub)
pcourse = Mid(word, 5, 6)
f = InStr(pcourse, "U")
PCode1 = Left(pcourse, f)
day = Sheets("Banner Summary").Cells(i, 15).Text
bTime = Sheets("Banner Summary").Cells(i, 16).Text
eTime = Sheets("Banner Summary").Cells(i, 17).Text
Subject = Sheets("Banner Summary").Cells(i, 2).Text
Course = Sheets("Banner Summary").Cells(i, 3).Text
Title = Sheets("Banner Summary").Cells(i, 4).Text
Section = Sheets("Banner Summary").Cells(i, 5).Text
CRN = Sheets("Banner Summary").Cells(i, 6).Text
ClassType = Sheets("Banner Summary").Cells(i, 9).Text
Room = Sheets("Banner Summary").Cells(i, 18).Text
Prof = Sheets("Banner Summary").Cells(i, 20).Text
BSubject = Worksheets("Banner Summary").Cells(i, 2)
BCourse = Worksheets("Banner Summary").Cells(i, 3)
BCode = BSubject & " " & BCourse
info = Prof & "-" & Subject & " " & Course & "-" & vbNewLine & Title & vbNewLine & CRN & "-" & ClassType & "-" & Section & vbNewLine & Room & ":" & bTime & "-" & eTime
RColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))
fcourse1 = PCode & PCode1
BCourse1 = Subject & Course
fcourse = Left(word, 10)
BCourse = Subject & " " & Course
result = StrComp(fcourse, BCourse)
result1 = StrComp(fcourse1, BCourse1)
If result = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
ElseIf result1 = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
End If
Next i
Next x
End Sub
只是一个简短的解释，案例是天数，(5, x) 是程序映射中我试图获取时间表的行。
下面是仅处理一天和一次时段的数据的方式：
Sub caseM(i As Variant)
day = Sheets("Banner Summary").Cells(i, 15).Text
bTime = Sheets("Banner Summary").Cells(i, 16).Text
eTime = Sheets("Banner Summary").Cells(i, 17).Text
Subject = Sheets("Banner Summary").Cells(i, 2).Text
Course = Sheets("Banner Summary").Cells(i, 3).Text
Title = Sheets("Banner Summary").Cells(i, 4).Text
Section = Sheets("Banner Summary").Cells(i, 5).Text
CRN = Sheets("Banner Summary").Cells(i, 6).Text
ClassType = Sheets("Banner Summary").Cells(i, 9).Text
Room = Sheets("Banner Summary").Cells(i, 18).Text
Prof = Sheets("Banner Summary").Cells(i, 20).Text
BSubject = Worksheets("Banner Summary").Cells(i, 2)
BCourse = Worksheets("Banner Summary").Cells(i, 3)
BCode = BSubject & " " & BCourse
info = Prof & "-" & Subject & " " & Course & "-" & vbNewLine & Title & vbNewLine & CRN & "-" & ClassType & "-" & Section & vbNewLine & Room & ":" & bTime & "-" & eTime
RColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))
Select Case bTime
Case "0810"
If eTime = "0900" Then
If T8 = 1 Then
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("B8").Value = info
Sheets("Schedule").Range("B8:B12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 2 Then
If Cells(8, 3) = RGB(0, 0, 0) And Cells(12, 3) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("C8").Value = info
Sheets("Schedule").Range("C8:C12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 3 Then
If Cells(8, 4) = RGB(0, 0, 0) And Cells(12, 4) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("D8").Value = info
Sheets("Schedule").Range("D8:D12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 4 Then
If Cells(8, 5) = RGB(0, 0, 0) And Cells(12, 5) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("E8").Value = info
Sheets("Schedule").Range("E8:E12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 5 Then
If Cells(8, 6) = RGB(0, 0, 0) And Cells(12, 6) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 6 Then
If Cells(8, 7) = RGB(0, 0, 0) And Cells(12, 7) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("G8").Value = info
Sheets("Schedule").Range("G8:G12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 7 Then
If Cells(8, 8) = RGB(0, 0, 0) And Cells(12, 8) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 8 Then
If Cells(8, 9) = RGB(0, 0, 0) And Cells(12, 9) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("F8").Value = info
Sheets("Schedule").Range("F8:F12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
End If
这是如何工作的，对于某个 btime，它将通过检查单元格的颜色来检查该时间和日期所需的单元格是否为空。由于某种原因，即使单元格没有颜色，它仍然会跳过它并继续下一个。
我知道这很长，但我已经和这件事抗争了一个多月了，真的需要一些帮助。提前感谢任何这样做的人。
我在你的代码中发现的问题是这部分
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
单元格将获取指定单元格的值。你正在将它与 RGB(0, 0, 0)
进行比较除非您的单元格为空或 0
，否则这将始终为假(RGB(0, 0, 0) 值为0，当单元格为空时，VBA会认为是0)
如果要对比实际颜色，需要放
Cells(8, 2).Interior.Color = RGB(0, 0, 0)
Cells(8, 2).Font.Color = RGB(0, 0, 0)
另外，代码越短，越容易排错
下面部分
If result = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
ElseIf result1 = 0 Then
Select Case day
Case "M"
Call caseM(i)
Case "T"
Call caseT(i)
Case "W"
Call caseW(i)
Case "R"
Call caseR(i)
Case "F"
Call caseF(i)
End Select
End If
由于您正在执行完全相同的程序，因此可以将其写为
If result = 0 or result1 = 0Then
Select Case day
Case "M": Call caseM(i)
Case "T": Call caseT(i)
Case "W": Call caseW(i)
Case "R": Call caseR(i)
Case "F": Call caseF(i)
End Select
End If
注意：":"" 表示在 ":" 之后将被视为下一行
还有下面的部分
If T8 = 1 Then
If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("B8").Value = info
Sheets("Schedule").Range("B8:B12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
ElseIf T8 = 2 Then
If Cells(8, 3) = RGB(0, 0, 0) And Cells(12, 3) = RGB(0, 0, 0) Then
Sheets("Schedule").Range("C8").Value = info
Sheets("Schedule").Range("C8:C12").Interior.Color = RColor
T8 = T8 + 1
Else
T8 = T8 + 1
End If
...........
可以改写为
If Cells(8, T8 + 1).Interior.Color = RGB(0, 0, 0) And Cells(12, T8 + 1).Interior.Color = RGB(0, 0, 0,) Then
Sheets("Schedule").Cells(8, T8 + 1).Value = info
Sheets("Schedule").Range(Cells(8, T8 + 1),Cells(12, T8 + 1)).Interior.Color = RColor
End if
T8 = T8 + 1