在两个不同的工作簿上工作，不能访问第二个工作表

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

崩溃发生在这一行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

我从来不喜欢这样的循环，直到find空白为止。 如果未find匹配项，则lin_ori_1和lin_ori_2将继续迭代，直到它们超过工作表上的行数为止，因为它们仅被独立重置为2是已find匹配项。

 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。