比较来自不同工作簿的两张纸,直到达到特定行

要求:1)从另一个工作簿(Book2)复制所需的工作表到当前活动的工作簿(Book1)2)有两种types的数据 – typesA和typesB – 被杵在一起例如: Book1

NV A 1 B 2 C 3 E 4 EFS files AA BB CC DD 

每种types的Book1都与Book2进行比较,即保持比较,直到在下一行中遇到“Type B”为止。3)如果在Book1中找不到匹配,则在当前位置将Book3中的整行复制到Book1

我已经写了下面的代码,但复制algorithm不能正常工作,即它遇到下一行中的“EFS文件”string时不停止:

 Private Sub CommandButton1_Click() ' ##CODE TO COPY THE DESIRED DEFAULT SHEET TO CURRENT WORKBOOK (BASE) Dim wkbSource As Workbook, wkbDest As Workbook Dim shtToCopy As Worksheet 'setting current workbook as destination Set wkbDest = ActiveWorkbook '1) add your own file path fileStr = "\\D:\Book2.xlsm" Set wkbSource = Workbooks.Open(fileStr) '2) add sheet name to be copied 'COPY ONLY IF THE SHEET IS NOT PRESENT Set shtToCopy = wkbSource.Sheets("Default") 'the sheet will be copied after 'Sheet1' of current workbook shtToCopy.Copy After:=wkbDest.Sheets("Sheet1") wkbSource.Close ' ##COPY ALGO: Copy non-duplicate NV items from Original (Book3) to the newly created base file (Book1) ' a) Check the B-column of both files ' b) If mismatch --> skip copying since base is given priority ' c) If an item is not present in Base, insert it in Base Dim varSheetA As Variant Dim varSheetB As Variant Dim strRangeToCheck As String Dim nvStr1 As String Dim nvStr2 As String Dim iRow As Long Dim iCol As Long Dim cmpResult As Integer nvStr1 = "EFS Files" Set wbkA = wkbDest Set varSheetA = wbkA.Worksheets("Default") Set wbkB = Workbooks.Open(filename:="\\D:\Book3.xlsm") Set varSheetB = wbkB.Worksheets("Default") iRow = 6 'Loop until value of cell = "EFS Files" Do While True 'COPY ALGORITHM If varSheetA.Cells(iRow, 2).Value = varSheetB.Cells(iRow, 2).Value Then ' Cells are identical. Do nothing. Else ' Cells are different. Copy the row to Base varSheetA.Cells(iRow, 2).Value = varSheetB.Cells(iRow, 2).Value End If iRow = iRow + 1 nvStr2 = Trim(varSheetB.Cells(iRow, 1).Value) cmpResult = StrComp(nvStr1, nvStr2) If cmpResult = 0 Then Exit Do End If 'End If Loop End Sub