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

时间：2016-06-07 19:05:27

标签： excel vba excel-vba backend

这是我第一次在这里提问。 所以这是我的问题： 我有一个非常大的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，它将通过检查单元格的颜色来检查该时间和日期所需的单元格是否为空。由于某种原因，即使细胞没有颜色，它仍会跳过它并继续下一个。

我知道这很长，但我现在已经用这个东西打了一个多月了，真的需要一些帮助。提前感谢任何人。

1 个答案:

答案 0 :(得分：0)

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

If Cells(8, 2) = RGB(0, 0, 0) And Cells(12, 2) = RGB(0, 0, 0) Then

单元格将获取指向单元格的值。你正在将它与 RGB（0,0,0）

进行比较

除非您的单元格为空或0

，否则这将始终为false

（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

注意：＆＃34;：＆＃34; 表示在＆＃34;之后：＆＃34; 将被视为下一行

以下部分

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
相关问题
最新问题