Question

要求： 1）将所需的工作表从另一个工作簿（Book2）复制到当前的活动工作簿（Book1） 2）有两种类型的数据 - 类型A和类型B - 它们共同聚集在一起例如： Book1 ：

NV
A 1
B 2
C 3
E 4
EFS files
A A
B B
C C
D D

将每种类型的Book1与Book2进行比较，即保持比较直到您在下一行遇到“Type B” 3）如果在Book1中找不到匹配项，则将整个行从Book3复制到Book1的当前位置

我编写了以下代码，但复制算法运行不正常，即它在下一行遇到“EFS文件”字符串时没有停止：

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

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

0 个答案: