Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 比较源工作表和目标工作表,并复制源工作表中不匹配的数据_Vba_Excel - Fatal编程技术网

Vba 比较源工作表和目标工作表,并复制源工作表中不匹配的数据

Vba 比较源工作表和目标工作表,并复制源工作表中不匹配的数据,vba,excel,Vba,Excel,我有两张Sht1和Sht2 我将表1的A列与表2的A列进行比较。两张图纸的A列都包含ID 如果sheet2中存在不匹配的ID,则我希望复制sheet1中不匹配的行 我尝试了下面的一个代码,问题是,它只是多次复制sheet2中不匹配的最后一行,并在不退出的情况下继续运行 谁能帮我纠正一下吗 Sub trialtest() Dim srcLastRow As Long, destLastRow As Long Dim srcWS As Worksheet, destWS As Wor

我有两张Sht1和Sht2

我将表1的A列与表2的A列进行比较。两张图纸的A列都包含ID

如果sheet2中存在不匹配的ID,则我希望复制sheet1中不匹配的行

我尝试了下面的一个代码,问题是,它只是多次复制sheet2中不匹配的最后一行,并在不退出的情况下继续运行

谁能帮我纠正一下吗

Sub trialtest()
    Dim srcLastRow As Long, destLastRow As Long
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    Set srcWS = ThisWorkbook.Sheets("S2")
    Set destWS = ThisWorkbook.Sheets("S1")
    srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row
    For i = 5 To destLastRow
        For j = 5 To srcLastRow
            If destWS.Cells(i, "A").Value <> srcWS.Cells(j, "A").Value Then
                 destWS.Cells(i, "A") = srcWS.Cells(j, "A")
                 destWS.Cells(i, "B") = srcWS.Cells(j, "B")
                 destWS.Cells(i, "C") = srcWS.Cells(j, "C")
                 destWS.Cells(i, "D") = srcWS.Cells(j, "D")
                 destWS.Cells(i, "E") = srcWS.Cells(j, "E")
                 destWS.Cells(i, "F") = srcWS.Cells(j, "F")
                 destWS.Cells(i, "G") = srcWS.Cells(j, "G")
                 destWS.Cells(i, "H") = srcWS.Cells(j, "H")
                 destWS.Cells(i, "I") = srcWS.Cells(j, "I")
                 destWS.Cells(i, "J") = srcWS.Cells(j, "J")
                 destWS.Cells(i, "K") = srcWS.Cells(j, "K")
                 destWS.Cells(i, "L") = srcWS.Cells(j, "L")
                 destWS.Cells(i, "M") = srcWS.Cells(j, "M")
                 destWS.Cells(i, "N") = srcWS.Cells(j, "N")
                 destWS.Cells(i, "O") = srcWS.Cells(j, "O")
                 destWS.Cells(i, "P") = srcWS.Cells(j, "P")
                 destWS.Cells(i, "Q") = srcWS.Cells(j, "Q")
                 destWS.Cells(i, "R") = srcWS.Cells(j, "R")
                 destWS.Cells(i, "S") = srcWS.Cells(j, "S")
             End If
         Next j
    Next i

    Application.ScreenUpdating = True
End Sub
Sub-trialtest()
将srcLastRow变长,将destLastRow变长
将SRCW设置为工作表,将DESTW设置为工作表
我和我一样长,我和我一样长
Application.ScreenUpdating=False
设置srcWS=thiswoolk.Sheets(“S2”)
Set destWS=thiswoolk.Sheets(“S1”)
srcLastRow=srcWS.Cells(srcWS.Rows.Count,“A”).End(xlUp).Row
destLastRow=destWS.Cells(destWS.Rows.Count,“A”).End(xlUp).Row
对于i=5到destLastRow
对于j=5至srcLastRow
如果destWS.Cells(i,“A”).值srcWS.Cells(j,“A”).值,则
destWS.Cells(i,“A”)=srcWS.Cells(j,“A”)
destWS.Cells(i,“B”)=srcWS.Cells(j,“B”)
destWS.Cells(i,“C”)=srcWS.Cells(j,“C”)
destWS.Cells(i,“D”)=srcWS.Cells(j,“D”)
destWS.Cells(i,“E”)=srcWS.Cells(j,“E”)
destWS.Cells(i,“F”)=srcWS.Cells(j,“F”)
destWS.Cells(i,“G”)=srcWS.Cells(j,“G”)
destWS.Cells(i,“H”)=srcWS.Cells(j,“H”)
destWS.Cells(i,“i”)=srcWS.Cells(j,“i”)
destWS.Cells(i,“J”)=srcWS.Cells(J,“J”)
destWS.Cells(i,“K”)=srcWS.Cells(j,“K”)
destWS.Cells(i,“L”)=srcWS.Cells(j,“L”)
destWS.Cells(i,“M”)=srcWS.Cells(j,“M”)
destWS.Cells(i,“N”)=srcWS.Cells(j,“N”)
destWS.Cells(i,“O”)=srcWS.Cells(j,“O”)
目标单元格(i,“P”)=目标单元格(j,“P”)
destWS.Cells(i,“Q”)=srcWS.Cells(j,“Q”)
destWS.Cells(i,“R”)=srcWS.Cells(j,“R”)
destWS.Cells(i,“S”)=srcWS.Cells(j,“S”)
如果结束
下一个j
接下来我
Application.ScreenUpdating=True
端接头
试试这段代码

Sub trialtest()
    Dim srcLastRow As Long, destLastRow As Long, rowIndex As Long
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim i As Long, j As Long
    Dim found As Boolean

    Application.ScreenUpdating = False

    Set srcWS = ThisWorkbook.Sheets("S2")
    Set destWS = ThisWorkbook.Sheets("S1")
    srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row
    rowIndex = destLastRow
    found = False
    For i = 5 To srcLastRow
        For j = 5 To destLastRow
            'Debug.Print srcWS.Cells(i, "A").Value & " : " & destWS.Cells(j, "A").Value
            If srcWS.Cells(i, "A").Value = destWS.Cells(j, "A").Value Then
                found = True
                'rowIndex = rowIndex + 1
                'destWS.Cells(rowIndex, "A") = srcWS.Cells(j, "A")
                Exit For
            End If
        Next j
        If found = False Then
            rowIndex = rowIndex + 1
            'destWS.Cells(rowIndex, "A") = srcWS.Cells(i, "A")
            destWS.Range("A" & rowIndex & ":S" & rowIndex).Value = srcWS.Range("A" & i & ":S" & i).Value
        End If
        found = False
    Next i

    Application.ScreenUpdating = True
End Sub

如果有什么不清楚的地方,请告诉我。

我会在这里使用find方法。使用find方法,您可以查看表S2中的ID是否位于表S1中

Sub trialtest()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("S2")
Set destWS = ThisWorkbook.Sheets("S1")
srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row



With destWS.Range(Cells(5, 1), Cells(destLastRow, 1))
    For j = 5 To srcLastRow

        Set c = .Find(srcWS.Cells(j, "A").Value, LookIn:=xlValues)
        ' if value not in destWS copy it form srcWS
        If c Is Nothing Then
            srcWS.Range("A" & j & ":S" & j).Copy _
            Destination:=destWS.Cells(destLastRow + 1, 1)
            destLastRow = destLastRow + 1
        End If

    Next j
End With

Application.ScreenUpdating = True
End Sub
如果在活页S1中找到ID,则变量c具有ID值。如果未在表S1中找到ID,则c的值为零。 然后,代码将从工作表S1复制ID列表末尾的行

Sub trialtest()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("S2")
Set destWS = ThisWorkbook.Sheets("S1")
srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row



With destWS.Range(Cells(5, 1), Cells(destLastRow, 1))
    For j = 5 To srcLastRow

        Set c = .Find(srcWS.Cells(j, "A").Value, LookIn:=xlValues)
        ' if value not in destWS copy it form srcWS
        If c Is Nothing Then
            srcWS.Range("A" & j & ":S" & j).Copy _
            Destination:=destWS.Cells(destLastRow + 1, 1)
            destLastRow = destLastRow + 1
        End If

    Next j
End With

Application.ScreenUpdating = True
End Sub

我知道您已经接受了答案,但我只想与您分享以下方法:

如果我正确理解了您的问题,如果表1中的ID不等于表2中的ID,那么用表2中的ID替换表1中的ID

选项显式
暗淡的i,n一样长
子IDReplace()
n=纸张(“Sheet1”).单元格(Rows.Count,1).结束(xlUp).行
附页(“第1页”)
对于i=2到n
如果.Cells(i,1).Value.Parent.Sheets(“Sheet2”).Cells(i,1).Value则
.Cells(i,1).Value=.Parent.Sheets(“Sheet2”).Cells(i,1).Value
如果结束
接下来我
以
端接头
基于工作表1是您关注的主要工作表这一事实,您只需要计算工作表1的行数,而不需要计算工作表2的行数


很乐意帮助:)

您想要“完全不匹配的行”是什么意思?@user1抱歉,这是一个输入错误。它是比较的,您希望如何“比较”不匹配的行?你为什么要这么做compare@user1很抱歉给您带来了混乱。我已经编辑了这个问题,我希望现在问题清楚了。好吧,我猜你没有正确理解这个问题。您要做的是将
Sheet1.A2
Sheet2.A2
进行比较,然后将
Sheet1.A3
Sheet2.A3
进行比较,依此类推,如果不相等,则替换值。但是OP希望将
Sheet1.A2
Sheet2.A2-Sheet2.A(lastrow)
匹配。