Question

有人可以帮我找出这个VBA代码有什么问题吗？在vba代码工作簿中，BASE在A列中有超过3000个项目，每行都有一个名称，例如：＆＃34; B-Y0011＆＃34;。我想在此vba代码中指定的另一个工作簿中搜索此项目＆＃39; wb＆＃39;。但是这本工作簿＆＃39; wb＆＃39;有三张。我必须在其中一张纸上找到该项目以及该项目所在的行位置。它运行了一次，但是当它找不到时，它就出错了。现在我尝试添加一个ERROR函数，它给了我另一个错误。

非常感谢

Sub ATUALIZAR_ALOCACAO()

Dim caminho As String, Dim j As Variant, Dim plan As Variant, Dim plan1 As 
Variant, Dim plan2 As Variant, Dim wb As Workbook, Dim ws As Worksheet

Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.EnableEvents = False

mes = InputBox("Qual o mês que você está consolidando informação de Diesel?")
ano = ThisWorkbook.Sheets("BASE").Range("R1").Value

ind_mes = Application.Match(mes, ThisWorkbook.Sheets("BASE").Range("L:L"), 0)
mes_aloc = ThisWorkbook.Sheets("BASE").Range("N" & ind_mes).Value
num_mes = ThisWorkbook.Sheets("BASE").Range("M" & ind_mes).Value

If num_mes < 10 Then
    num_mes_cod = "0" & num_mes
Else
    num_mes_cod = num_mes
End If

caminho = "\\sedenas01\carnaxide\A&CCC\15 - Brasil - Inovação e 
Desenvolvimento\PDCAs\Consumo Diesel\Alocação\2017\" & num_mes_cod & 
".RELAÇÃO DE FROTAS GERAL IC " & mes_aloc & " " & ano & ".xls"
Set wb = Workbooks.Open(Filename:=caminho, ReadOnly:=True)

With wb
    lastrow = ThisWorkbook.Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        j = ThisWorkbook.Sheets("BASE").Cells(i, 1).Value
        plan = Application.Match(j, wb.Sheets("BETONEIRAS").Range("K:K"), 0)

        On Error Resume Next

        If plan > 0 Then

            wb.Sheets("BETONEIRAS").Range("M" & plan).Copy
            ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues

            wb.Sheets("BETONEIRAS").Range("P" & plan).Copy
            ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues

        Else

            plan1 = Application.Match(j, wb.Sheets("BOMBAS DE CONCRETO").Range("K:K"), 0)

            If plan1 > 0 Then

                wb.Sheets("BOMBAS DE CONCRETO").Range("M" & plan1).Copy
                ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues

                wb.Sheets("BOMBAS DE CONCRETO").Range("P" & plan1).Copy
                ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues

            Else

                plan2 = Application.Match(j, wb.Sheets("BOMBAS DE CONCRETO").Range("H:H"), 0)

                If plan2 > 0 Then

                    wb.Sheets("PÁS CARREGADEIRAS").Range("J" & plan2).Copy
                    ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues

                    wb.Sheets("PÁS CARREGADEIRAS").Range("L" & plan2).Copy
                    ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues

                End If
            End If
        End If
    Next

End With

wb.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

VBA与If匹配时出错

0 个答案: