Excel VBA 代码读取一些行并丢弃其他行答案

【问题标题】：Excel VBA code reads some rows and discards othersExcel VBA 代码读取一些行并丢弃其他行
【发布时间】：2016-10-07 19:53:10
【问题描述】：

这是我第一次在这里提问。所以这是我的问题：我有一个相当大的 vba 代码，但我会给你一个简短的总结。

我有一张包含课程信息的表格，例如：课程代码、主题、教授、日期、btime、etime 等... 和另一张表，其中包含我正在寻找的课程以创建时间表。

因此代码将读取两张纸并比较它们，然后将数据输出到另一张纸上。问题是，如果假设一门课程有 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）是我试图获取时间表的程序地图中的行。

这里只处理 ONE DAY 和 ONE TIME SLOT 的数据：

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，它将通过检查单元格的颜色来检查该时间和日期所需的单元格是否为空。并且由于某种原因，即使单元格没有颜色，它仍然会跳过它并继续下一个。

我知道这很长，但我已经与这件事作斗争了一个多月，真的需要一些帮助。提前感谢任何这样做的人。

【问题讨论】：

请重新缩进你的第二个代码块？
您有Select Case bTime，但随后进入许多if 语句......

标签： vba excel backend

【解决方案1】：

我在你的代码中发现的问题就是这部分

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

【讨论】：

这个信息看起来很有用，我会尝试一下并尽快回复你，比你非常多。
嘿 MutjatLee，我再次感谢您的帮助，但是尽管对我来说您给我的代码看起来很可靠并且应该可以正常工作，但现在我运行它以找到星期一的时间表从字面上跳过任何周一的课程，有什么想法/建议吗？
其他日子，虽然它跳过了一堆课程，但它仍然输出很多报价，所以我不知道如何处理这个:((
这意味着要么它没有正确获取源，要么输出错误。我要建议的是，在你的宏上，按 F8。这将一行一行地运行宏。您可以将鼠标移到某些变量（例如 i）上，然后它会告诉您 i 的值是什么。如果代码获得或输出正确的值，这就是您解决代码问题的方式。