Question

我有2张纸

Sheet 1 :

QWE   |  ZXC
A     1 
B     2
C     3

Sheet 2: 

WER   |  EWQ
A      1 
G     2
H     3

我希望输出看起来像下面给出的那样。有没有可以实现这一目标的公式，或者是宏，因为我正在寻求使该任务自动化。

Output:
Col 1 | Col 2
A       1
B       2
C       3
G    
H

另一种解决方案是比较QWE和WER列，并将差异粘贴到另一张纸上，然后将其附加到第一张纸上

Answer 1

一个快速而肮脏的版本（没有暗淡，潜艇等）如下：

aRow = 1
cRow = 1

While Worksheets("Sheet 1").Cells(cRow, 1) <> vbNullString
    bCol = 1
    DVar = vbNullString

    While bCol < 3
        DVar = Worksheets("Sheet 1").Cells(cRow, bCol)
        If WorksheetFunction.CountIf(Worksheets("Output").Range("A:B"), DVar) = 0 Then
            Worksheets("Output").Cells(aRow, bCol) = DVar
        End If

        bCol = bCol + 1
        DVar = vbNullString
    Wend

    If Worksheets("Output").Cells(aRow, 1) <> vbNullString Then
        aRow = aRow + 1
    End If

    cRow = cRow + 1

Wend

cRow = 1

While Worksheets("Sheet 2").Cells(cRow, 1) <> vbNullString
    bCol = 1
    DVar = vbNullString

    While bCol < 3
        DVar = Worksheets("Sheet 2").Cells(cRow, bCol)
        If WorksheetFunction.CountIf(Worksheets("Output").Range("A:B"), DVar) = 0 Then
            Worksheets("Output").Cells(aRow, bCol) = DVar
        End If

        bCol = bCol + 1
        DVar = vbNullString
    Wend

    If Worksheets("Output").Cells(aRow, 1) <> vbNullString Then
        aRow = aRow + 1
    End If

    cRow = cRow + 1

Wend

Answer 2

这就是我的方法。

Sub OneCell()



Sheets("DOCCS File").Columns(1).Copy Destination:=Sheets("Sheet3").Columns(1)
Sheets("IG Numbers").Select
Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range, sh3 As Worksheet
Set sh4 = Sheets("IG Numbers")
Set sh5 = Sheets("Sheet3")
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("A2:A" & lr)
rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2)
sh5.Columns(2).EntireColumn.Delete
sh5.Columns(1).EntireColumn.Interior.ColorIndex = 4
Dim i As Long, f As Variant

With Worksheets("Sheet3")
    For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
        f = Application.Match(.Cells(i, "A").Value2, Worksheets("DOCCS File").Columns("A"), 0)
        If Not IsError(f) Then
            Else
            Worksheets("DOCCS File").Cells(i, "A").Copy
            .Cells(i, "A").Interior.ColorIndex = 6
        End If
    Next i
End With

a = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet3").Cells(i, 1).Interior.ColorIndex = 6 Then
Worksheets("Sheet3").Rows(i).Copy
Worksheets("DOCCS File").Activate

b = Worksheets("DOCCS File").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("DOCCS File").Cells(b + 1, 1).Select
ActiveSheet.Paste
End If
Next

Application.CutCopyMode = False
sh5.Columns(1).EntireColumn.Delete

End Sub

插入与现有行不匹配的行

2 个答案: