Question

我正试图找出Excel中的问题。我收到内存不足的错误，我怀疑这不是问题，但我真的不知道。

基本上，我正在尝试创建一个宏来搜索电子表格中5个选项卡中的列（该列可以是5个中的任意一个并且它会发生很大变化），当它找到它时，vlookup会匹配将列返回到主选项卡中的适当位置。这是我下面的代码，它似乎应该工作，但我得到Out of Memory错误。我去调试时突出显示的行是if语句中的第一行Vrange = rB。

Dim i As Integer
Dim r As Range
'
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim wsB As Worksheet: Set wsB = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("B")
Dim wsE As Worksheet: Set wsE = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("E")
Dim wsL As Worksheet: Set wsL = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("L")
Dim wsI As Worksheet: Set wsI = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("I")
Dim wsT As Worksheet: Set wsT = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("T")
'
Dim rBHeading As Range: Set rBHeading = wsB.Range("A2:ZA2")
Dim rEHeading As Range: Set rEHeading = wsE.Range("A2:ZA2")
Dim rLHeading As Range: Set rLHeading = wsL.Range("A2:ZA2")
Dim rIHeading As Range: Set rIHeading = wsI.Range("A2:ZA2")
Dim rTHeading As Range: Set rTHeading = wsT.Range("A2:ZA2")
'
Dim rB As Range: Set rB = wsB.Range("A:ZA")
Dim rE As Range: Set rE = wsE.Range("A:ZA")
Dim rL As Range: Set rL = wsL.Range("A:ZA")
Dim rI As Range: Set rI = wsI.Range("A:ZA")
Dim rT As Range: Set rT = wsT.Range("A:ZA")
'
Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"
'
If Application.CountIf(rBHeading, "iA") = 1 Then
    Vrange = rB
    Mrange = rBHeading
ElseIf Application.CountIf(rEHeading, "iA") = 1 Then
    Vrange = rE
    Mrange = rEHeading
ElseIf Application.CountIf(rLHeading, "iA") = 1 Then
    Vrange = rL
    Mrange = rLHeading
ElseIf Application.CountIf(rIHeading, "iA") = 1 Then
    Vrange = rI
    Mrange = rIHeading
Else
    Vrange = rT
    Mrange = rTHeading
End If
'
Dim mf_iA As Variant: mf_iA = Application.Match(mf_iA_TEXT, Mrange, 0)
'
With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    MsgBox lastrow
End With
'
For i = 2 To lastrow
    wsMaster.Cells(i, 2) = Application.VLookup(wsMaster.Cells(i, 1), Vrange, mf_iA, 0)
Next i
'
End Sub

我也尝试用case语句完成这个，但我觉得我对上面的代码有了进一步的了解。如果你能告诉我这段代码是否愚蠢，或者如果我能解决Out of Memory错误，我将非常感激。如果我可以让它工作，我将复制更多列的过程，以防万一。谢谢！

Answer 1

为了帮助您入门，前56行代码可以写成，

    Dim v As Long, vWSs As Variant, Mrange As Range, Vrange As Range, mf_iA as long
    Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
    Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"

    vWSs = Array("B", "E", "L", "I", "T")
    With Workbooks("LBImportMacroTemplate.xlsm")
        mf_iA = 0: Set Mrange = Nothing: Set Vrange = Nothing
        For v = LBound(vWSs) To UBound(vWSs)
            If CBool(Application.CountIf(.Sheets(vWSs(v)).Range("A2:ZA2"), mf_iA_TEXT)) Then
                Set Mrange = .Sheets(vWSs(v)).Range("A2:ZA2")
                Set Vrange = .Sheets(vWSs(v)).Range("A:ZA")
                ' added the column number assignment on the next line
                mf_iA = application.match(mf_iA_TEXT, Mrange, 0)
                Exit For
            End If
        Next v
    End With

    if mf_iA = 0 then msgbox "Stop here! " & mf_iA_TEXT & "not found!"
    'assumed that Mrange and Vrange are not nothing at this point
    ' and that mf_iA is the numerical column index number for mf_iA_TEXT
    'do something with them


    Set Mrange = Nothing
    Set Vrange = Nothing
    Set wsMaster = Nothing

这会将您带到可以继续处理的If/ElseIf/End If的末尾。最后三个只是在完成后手动将范围和工作簿对象设置为空的提醒。

If语句中的Excel VBA内存不足错误

1 个答案: