在兩個不同的工作簿上工作，無法訪問第二個工作表

我有一個程序來比較我的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

來源

2017-11-11 Carlos Coelho

而不是循環無休止地閱讀有關使用Find和FindNext。它會加速你的代碼的運行時間很多 –

我從來不喜歡這些類型的做雖然這個不斷循環，直到他們找到一個空循環。如果未找到匹配項，則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。

來源

2017-11-11 18:02:54 Jeeped

好吧，我對excel-vba編程有點新，我正在努力改進。我已經看過功能與之前，但我從來沒有理解它是如何工作的。你所做的一切都是正確的，現在它運行得非常快。 WOW 感謝您的幫助，我將學習此代碼，以便我可以改進！ –

實質上，'用taxasWks ... End With'塊意味着該塊內的任何'.Cells（...）'都屬於taxasWks工作表。 – Jeeped

此外，不要嘗試使用'Application.Worksheet.Match'或'Worksheet.Match'。要將錯誤捕獲到變體中，您需要'Application.Match'。 – Jeeped

在兩個不同的工作簿上工作，無法訪問第二個工作表

回答

相關問題