Question

我有一个程序来比较我的ThisWorkbook和其他工作簿之间是否匹配。它正在做一切正常，除非代码应该在另一个工作簿的第二个工作表中找到文本。它会迭代直到它崩溃。我试图找到的文本单元格存在于两个文件中但由于某些原因我的代码无法识别它（我已经验证了格式，两者都是文本格式）

崩溃发生在这一行Case taxasWks.Cells(lin_dest, 4) = transf1Wks.Cells(lin_ori_2, 1)：

错误是：运行时错误1004 应用程序定义或对象定义的错误

    Dim consultaWbk As Excel.Workbook
    Dim linhas1Wks As Excel.Worksheet
    Dim linhas2Wks As Excel.Worksheet
    Dim transf1Wks As Excel.Worksheet
    Dim transf2Wks As Excel.Worksheet
    Dim taxasWks As Excel.Worksheet
    Dim lin_dest As Long
    Dim lin_ori_1 As Long
    Dim lin_ori_2 As Long




    Set consultaWbk = Workbooks.Open("C:\Users\Feels Bad Man\Dropbox\Tesingz\tesingz\Com paineis de transformador - versao 2.xlsm")

    Set linhas1Wks = consultaWbk.Worksheets("Taxas linhas")
    Set linhas2Wks = consultaWbk.Worksheets("Tempo médio de reposição linhas")
    Set transf1Wks = consultaWbk.Worksheets("Taxas Transformadores")
    Set transf2Wks = consultaWbk.Worksheets("Tempo médio de reposição transf")
    Set taxasWks = ThisWorkbook.Worksheets("taxas falha temp med rep")

     lin_dest = 2
     lin_ori_1 = 2
     lin_ori_2 = 2


    Do While taxasWks.Cells(lin_dest, 1) <> ""

            Select Case True

            Case taxasWks.Cells(lin_dest, 4).Value2 = linhas1Wks.Cells(lin_ori_1, 1).Value2:

                 taxasWks.Cells(lin_dest, 5).Value2 = linhas1Wks.Cells(lin_ori_1, 3).Value2
                 taxasWks.Cells(lin_dest, 6).Value2 = linhas1Wks.Cells(lin_ori_1, 4).Value2
                 taxasWks.Cells(lin_dest, 7).Value2 = linhas1Wks.Cells(lin_ori_1, 5).Value2
                 taxasWks.Cells(lin_dest, 8).Value2 = linhas1Wks.Cells(lin_ori_1, 6).Value2
                 taxasWks.Cells(lin_dest, 9).Value2 = linhas1Wks.Cells(lin_ori_1, 7).Value2
                 taxasWks.Cells(lin_dest, 10).Value2 = linhas2Wks.Cells(lin_ori_1, 2).Value2
                 taxasWks.Cells(lin_dest, 11).Value2 = linhas2Wks.Cells(lin_ori_1, 3).Value2
                 taxasWks.Cells(lin_dest, 12).Value2 = linhas2Wks.Cells(lin_ori_1, 4).Value2
                 taxasWks.Cells(lin_dest, 13).Value2 = linhas2Wks.Cells(lin_ori_1, 5).Value2
                 taxasWks.Cells(lin_dest, 14).Value2 = linhas2Wks.Cells(lin_ori_1, 6).Value2

                 lin_dest = lin_dest + 1
                 lin_ori_1 = 2


            Case Else:

                 lin_ori_1 = lin_ori_1 + 1

            End Select


                Select Case True

                Case taxasWks.Cells(lin_dest, 4).Value2 = transf1Wks.Cells(lin_ori_2, 1).Value2:

                 taxasWks.Cells(lin_dest, 5).Value2 = transf1Wks.Cells(lin_ori_2, 2).Value2
                 taxasWks.Cells(lin_dest, 6).Value2 = transf1Wks.Cells(lin_ori_2, 3).Value2
                 taxasWks.Cells(lin_dest, 7).Value2 = transf1Wks.Cells(lin_ori_2, 4).Value2
                 taxasWks.Cells(lin_dest, 8).Value2 = transf1Wks.Cells(lin_ori_2, 5).Value2
                 taxasWks.Cells(lin_dest, 9).Value2 = transf1Wks.Cells(lin_ori_2, 6).Value2
                 taxasWks.Cells(lin_dest, 10).Value2 = transf2Wks.Cells(lin_ori_2, 2).Value2
                 taxasWks.Cells(lin_dest, 11).Value2 = transf2Wks.Cells(lin_ori_2, 3).Value2
                 taxasWks.Cells(lin_dest, 12).Value2 = transf2Wks.Cells(lin_ori_2, 4).Value2
                 taxasWks.Cells(lin_dest, 13).Value2 = transf2Wks.Cells(lin_ori_2, 5).Value2
                 taxasWks.Cells(lin_dest, 14).Value2 = transf2Wks.Cells(lin_ori_2, 6).Value2


                 lin_dest = lin_dest + 1
                 lin_ori_2 = 2


                Case Else:

                    lin_ori_2 = lin_ori_2 + 1

                End Select


Loop


    Set linhas1Wks = Nothing
    Set linhas2Wks = Nothing
    Set transf1Wks = Nothing
    Set transf2Wks = Nothing
    consultaWbk.Close SaveChanges:=False


    Set consultaWbk = Nothing

    MsgBox "END"


End Sub

Answer 1

我从不喜欢这些Do While循环，它们会一直循环，直到找到空白。如果未找到匹配项，则lin_ori_1和lin_ori_2将继续迭代，直到它们超过工作表上的行数，因为它们只是独立重置为2才能找到匹配项。

Dim fnd As Variant
With taxasWks
    For lin_dest = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        fnd = Application.Match(.Cells(lin_dest, 4).Value2, linhas1Wks.Columns(1), 0)
        If Not IsError(fnd) Then
            'a match was found
            .Cells(lin_dest, 5) = linhas1Wks.Cells(fnd , 3).Value2
            .Cells(lin_dest, 6) = linhas1Wks.Cells(fnd , 4).Value2
            .Cells(lin_dest, 7) = linhas1Wks.Cells(fnd , 5).Value2
            .Cells(lin_dest, 8) = linhas1Wks.Cells(fnd , 6).Value2
            .Cells(lin_dest, 9) = linhas1Wks.Cells(fnd , 7).Value2
            .Cells(lin_dest, 10) = linhas2Wks.Cells(fnd , 2).Value2
            .Cells(lin_dest, 11) = linhas2Wks.Cells(fnd , 3).Value2
            .Cells(lin_dest, 12) = linhas2Wks.Cells(fnd , 4).Value2
            .Cells(lin_dest, 13) = linhas2Wks.Cells(fnd , 5).Value2
            .Cells(lin_dest, 14) = linhas2Wks.Cells(fnd , 6).Value2
        End If
        fnd = Application.Match(.Cells(lin_dest, 4).Value2, transf1Wks.Columns(1), 0)
        If Not IsError(fnd) Then
            'a match was found
            .Cells(lin_dest, 5) = transf1Wks.Cells(fnd , 2).Value2
            .Cells(lin_dest, 6) = transf1Wks.Cells(fnd , 3).Value2
            .Cells(lin_dest, 7) = transf1Wks.Cells(fnd , 4).Value2
            .Cells(lin_dest, 8) = transf1Wks.Cells(fnd , 5).Value2
            .Cells(lin_dest, 9) = transf1Wks.Cells(fnd , 6).Value2
            .Cells(lin_dest, 10) = transf2Wks.Cells(fnd , 2).Value2
            .Cells(lin_dest, 11) = transf2Wks.Cells(fnd , 3).Value2
            .Cells(lin_dest, 12) = transf2Wks.Cells(fnd , 4).Value2
            .Cells(lin_dest, 13) = transf2Wks.Cells(fnd , 5).Value2
            .Cells(lin_dest, 14) = transf2Wks.Cells(fnd , 6).Value2
        End If
    Next lin_dest
End With

不要为.Value2属性分配值;将另一个单元格的.Value2指定为默认的.Value。

使用两个不同的工作簿，无法访问第二个工作表

1 个答案: