如果声明跳过结果动作

Question

我遇到了一个我很难理解的问题，我希望你们可以提供帮助。

我的if语句没有执行真实结果的操作，我不知道为什么。我在代码中早先使用了类似的条件，没有任何问题。

这是我遇到的代码部分：

   Option Explicit
Option Base 1
Function binsearch(ByRef strArray() As String, ByRef strSearch As String) As Long
Dim lngIndex As Long
Dim lngFirst As Long
Dim lngLast As Long
Dim lngMiddle As Long
Dim bolInverseOrder As Boolean
lngFirst = LBound(strArray)
lngLast = UBound(strArray)
bolInverseOrder = (strArray(lngFirst) > strArray(lngLast))
binsearch = lngFirst - 1

Do
    lngMiddle = (lngFirst + lngLast) \ 2
    If strArray(lngMiddle) = strSearch Then
        binsearch = lngMiddle
        strSearch = strArray(lngMiddle)
        Exit Do
    ElseIf ((strArray(lngMiddle) < strSearch) Xor bolInverseOrder) Then
        lngFirst = lngMiddle + 1
    Else
        lngLast = lngMiddle - 1
    End If
Loop Until lngFirst > lngLast


End Function
Public Sub RE()

Dim MasterData As Variant, toFind As Variant, toFound As Variant
Dim WS As Worksheet, WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim st_date As Date, end_date As Date, Tran_date As Date
Dim lastrow As Long, lastrow1 As Long, lastrow2 As Long, lastcol As Long, erow As Long, erow1 As Long, ecol As Long, Low As Long, Mid As Long, high As Long
Dim st_cell As Range, mydata As Range, DDT As Range, DDT1 As Range, DDT2 As Range
Dim Sheetname As String, Descr1 As String, Descr2() As String, Descr3() As String
Dim mydata1 As Variant, mydata2 As Variant, mydata3 As Variant
Dim amount1 As Currency, amount2 As Currency, amount3 As Currency
Dim i As Long

Application.ScreenUpdating = True


With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\mpofa\Downloads\transactionHistory (1).csv", Destination:= _
        Range("$A$1"))
        .Name = "transactionHistory (1)_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(5, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With

    ActiveWorkbook.Sheets(ActiveSheet.Name).Name = "Main page"
    Set WS = Sheets("main page")
    Set st_cell = Sheets("main page").Range("A2")

    lastrow = WS.Cells(WS.Rows.Count, st_cell.Column).End(xlUp).row
    lastcol = WS.Cells(st_cell.row, WS.Columns.Count).End(xlToLeft).Column

    Columns("A:A").Select
    ActiveWorkbook.Worksheets("main page").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main page").sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main page").sort
        .SetRange Range("A:D")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


 Dim x As Long
     For x = 0 To -2 Step -1
        end_date = Sheets("main page").Range("A2").Value
        st_date = DateAdd("m", x, end_date)
        Worksheets.Add after:=Sheets("main page")

Dim p As Long, q As Long, y As Long
    p = Worksheets.Count
    For q = 1 To p
        With Worksheets(q)
            Sheetname = Format(st_date, "yyyy-mmm")
            ActiveSheet.Name = Sheetname
        End With



    Sheets("Main page").Select
    Range("A1:C1").Select
    Selection.Copy

    Sheets(Sheetname).Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.NumberFormat = "yyyy/mm/dd"
    Columns("C:C").Select
    Selection.NumberFormat = "R#,##0.00_);(R#,##0.00)"
    Worksheets("main page").Activate
    Columns("A:A").Select
    Selection.NumberFormat = "yyyy/mm/dd"
    Range("A2").Select






    For i = 2 To lastrow
        Tran_date = WS.Cells(i, 1)
        If Month(Tran_date) = Month(st_date) Then
            erow = Sheets(Sheetname).Cells(1, 1).CurrentRegion.Rows.Count + 1
            Sheets(Sheetname).Cells(erow, 1) = WS.Cells(i, "a")
            Sheets(Sheetname).Cells(erow, 2) = WS.Cells(i, "b")
            Sheets(Sheetname).Cells(erow, 3) = WS.Cells(i, "c")
            ecol = Sheets(Sheetname).Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        End If
            Sheets(Sheetname).Select
            Columns("A:A").Select
            Columns("A:A").EntireColumn.AutoFit
            Columns("B:B").Select
            Columns("B:B").EntireColumn.AutoFit
            Columns("C:C").Select
            Columns("C:C").EntireColumn.AutoFit



    Next i

    Next q
    Next x


        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(ActiveSheet.Name).Name = "Report"
        Sheets("Report").Range("A1") = "Description"
        Sheets("Report").Range("B1") = "Amount"
        erow1 = Sheets("report").Cells(1, 1).CurrentRegion.Rows.Count + 1

    Set WS1 = ThisWorkbook.Sheets(2)
    Set WS2 = ThisWorkbook.Sheets(3)
    Set WS3 = ThisWorkbook.Sheets(4)

    With WS1.Range("B:B")
    .sort key1:=WS1.Range("B1"), Header:=xlYes
    Set mydata1 = Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    MasterData = mydata1.Value

    Set DDT = WS1.Range("B2")
    lastrow = WS1.Cells(WS1.Rows.Count, DDT.Column).End(xlUp).row

    With WS2.Range("B:B")
    .sort key1:=WS2.Range("B1"), Header:=xlYes

    End With
    Set DDT1 = WS2.Range("B2")
    lastrow1 = WS2.Cells(WS2.Rows.Count, DDT1.Column).End(xlUp).row

    With WS3.Range("B:B")
    .sort key1:=WS3.Range("B1"), Header:=xlYes
    End With
    Set DDT2 = WS3.Range("B2")
    lastrow2 = WS3.Cells(WS3.Rows.Count, DDT2.Column).End(xlUp).row


    For Each WS In ThisWorkbook.Sheets
    Do While WS.Name <> "main page"

    For i = 2 To lastrow
        Descr1 = WS1.Cells(i, 2).Text

'            Set mydata2 = Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp))
            For p = 2 To lastrow1
                ReDim Descr2(p)
                Descr2(p) = WS2.Cells(p, 2).Text
                ReDim Preserve Descr2(p)
                Call binsearch(Descr2(), Descr1)




'           Set mydata3 = Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp))
            For q = 2 To lastrow2
            ReDim Descr3(q)
                Descr3(q) = WS3.Cells(q, 2).Text
                ReDim Preserve Descr3(q)
                Call binsearch(Descr3(), Descr1)
                If binsearch(Descr3(), Descr1) = 1 Then
                    Descr1 = Trim(Descr3(q))
                    Else
                End If


                If binsearch(Descr3(), Descr1) = 1 Then
                    Descr1 = Trim(Descr3(q))
                    Else
                End If

            If Descr1 = Trim(Descr3(q)) & Descr1 = Trim(Descr2(p)) Then
                  Sheets("report").Cells(erow1, 1) = WS1.Cells(i, "b")
                  Sheets("report").Cells(erow1, 2) = WS1.Cells(i, "c")
            End If

        Next q
        Next p




    Next i
    Loop
    Next WS





    Sheets("Report").Select
            Columns("A:A").Select
            Columns("A:A").EntireColumn.AutoFit
            Columns("B:B").Select
            Columns("B:B").EntireColumn.AutoFit


End Sub

我得到了一个真实的条件，但细胞信息没有进入预期的表格。我真的很震惊，请帮忙。

提前致谢。

Answer 1

答案是此代码不完整且无法运行：您尚未定义循环。请尝试“Debug - ＆gt; Compile VBAProject”;当你在那里没有错误而仍然没有你想要的表现时，再问一遍。