Question

我一直试图解决这个问题好几个星期。我有一个具有用户表单的模板。此用户表单选择当前月份报告和上个月报告，并在当前月份报告中运行vlookup。它在B列中运行vlookup。问题是，代码运行vlookup并且没有停止，我需要它一旦它到达C列中的空白单元就停止。这是代码。我在这里急需帮助。谢谢！

Private Sub CommandButton1_Click()
    Dim str1 As String
    Dim str2 As String
    Dim i As Integer

    Application.ScreenUpdating = False

    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            str1 = ListBox1.List(i)
        End If
    Next i

    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            str2 = ListBox2.List(i)
        End If
    Next i

    Workbooks(str1).Activate
    Sheets(1).Activate
    Range("B1").Select
    i = 0
    Do Until ActiveCell.Offset(i, 0).Value = "Category"
        i = i + 1
    Loop
    Range("B1").Offset(i, 0).Select
    With Range(ActiveCell.Offset(1), Cells(ActiveSheet.UsedRange.Rows.Count, 2))
        .Formula = "=VLOOKUP(C" & ActiveCell.Offset(1).Row & ",'[" & str2 & "]Sheet1'!$A$4:$B$200,2,FALSE)"
    End With

    Application.ScreenUpdating = True
End Sub

Answer 1

...也许

Private Sub CommandButton1_Click()

    Dim lMacroSec As MsoAutomationSecurity
    Dim lCalc As XlCalculation
    Dim i As Long
    Dim j As Long

    With Application
        lMacroSec = .AutomationSecurity
        lCalc = .Calculation
        .AutomationSecurity = lMacroSec
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            For j = 0 To ListBox2.ListCount - 1
                If ListBox2.Selected(j) = True Then
                    With Workbooks(ListBox1.List(i)).Sheets(1)
                        With .Columns("B").Find("Category").Offset(1)
                            With .Parent.Range(.Cells, .Offset(-1, 1).End(xlDown).Offset(, -1))
                                .Formula = "=VLOOKUP(C" & .Row & ",'[" & ListBox2.List(j) & "]Sheet1'!$A$4:$B$200,2,FALSE)"
                                .Calculate
                            End With
                        End With
                    End With
                End If
            Next j
        End If
    Next i

    With Application
        .AutomationSecurity = lMacroSec
        .Calculation = lCalc
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

vlookup直到空白单元格

1 个答案: