Question

无法创建可执行以下操作的宏。

A列和C列中的值 B栏和D栏中的数字

宏需要将列A和B的数据与列C和D进行比较，并将重复数据剪切/移动到Sheet2。它需要与表格1完全相同的格式。值，数字，值，数字。

最后我应该留下A列中的所有条目：不匹配的条目D和表2中匹配的所有条目

我尝试使用上一个问题收到的代码，但没有运气。它似乎不想搜索两列。

example:
Sheet 1 before start
Column A   Column B   Column C   Column D
20         10         10         20
10         7          17         10
10         20         8          7
10         7          10         7

then afterwards:
Sheet 1:
Column A   Column B   Column C   Column D
20         10        17         10
10         7         8          7

Sheet 2:
Column A   Column B   Column C   Column D
10         7          10         20
10         20         10         7

我的尝试不检查两列但只检查一列，因为我不知道如何检查两者，然后第二个将信息从第二列复制到表2.关于何时复制的if语句不工作正常，还没有循环。我对vba的了解非常有限

Sub Matchin()

Dim wsMain As Worksheet, wsOutput As Worksheet
Dim lRowColA As Long, lRowColB As Long, i As Long, j As Long
Dim Acell As Range, ColARng As Range, ColBRng As Range

'~~> Set input Sheet and output sheet
Set wsMain = ThisWorkbook.Sheets("Balancing")
Set wsOutput = ThisWorkbook.Sheets("Remove")

'~~> Start Row in output sheet
j = 1

With wsMain
    '~~> Get last row in Col A & B
    lRowColA = .Range("A" & .Rows.Count).End(xlUp).Row
    lRowColB = .Range("C" & .Rows.Count).End(xlUp).Row

    '~~> Set your actual data range in Col A and B
    Set ColARng = .Range("A1:A" & lRowColA)
    Set ColBRng = .Range("C1:C" & lRowColB)

    '~~> Loop through Col A
    For i = 1 To lRowColA
        If Len(Trim(.Range("A" & i).Value)) <> 0 Then
            '~~> Check if there are duplicates of Col A value in Col B
            If Application.WorksheetFunction.CountIf(ColBRng, _
            .Range("A" & i).Value) > 0 Then

                '~~> If found write to output sheet
                wsOutput.Cells(j, 1).Value = .Range("A" & i).Value
                wsOutput.Cells(j, 3).Value = .Range("A" & i).Value

                '~~> Find the duplicate value in Col B
                Set Acell = ColBRng.Find(What:=.Range("A" & i).Value, _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                '~~> Clear the duplicate value in Col B
                Acell.ClearContents
                '~~> Clear the duplicate value in Col A
                .Range("A" & i).ClearContents

                '~~> Set i = 1 to restart loop and increment
                '~~> the next row for output sheet
                i = 1: j = j + 1
            End If
        End If
    Next i

End With
End Sub

Sub bit()

Dim i As Long
Dim j As Long
Dim cola As Integer, colb As Integer, rng As Range, n#, b#

cola = Range("A1:A8000").Count
colb = Range("B1:B8000").Count

If cola <> colb Then

Range("A:A").Select

Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
ActiveCell.Copy
Sheets("Remove").Select
Range("B:B").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Activate
ActiveCell.PasteSpecial

Sheets("Balancing").Select
ActiveCell.Offset(0, -1).Select
ActiveCell.Resize(1, 2).Select
Selection.Delete Shift:=xlUp


End If

End Sub

任何帮助将不胜感激。谢谢

Answer 1

解决方案1 

你需要遍历A＆amp; B栏并与C＆amp; C进行比较d。

Dim wsh As Worksheet
Dim i As Long, j As Long
Dim str1 As String, str2 As String
Set wsh = ThisWorkbook.Worksheets("Sheet1")

i = 2
Do While wsh.Range("A" & i) & wsh.Range("B" & i) <>""
    str1 = wsh.Range("A" & i) & wshRange("B" & i)
    j = i
    Do While wsh.Range("C" & j) & wsh.Range("D" & j) <>""
        str2 = wsh.Range("C" & j) & wsh.Range("D" & j)
        If str1 = str2 Then
            'your logic here
        End If
        j = j+1
    Loop
    i = i+1
Loop

注意：这很慢。我决定展示它以提供基本比较（每个比较）。

解决方案2

如果您没有关于SQL和ADO的基本知识，则解决方案2有点复杂。使用这样的命令：

SELECT A, B
FROM [Sheet1$] 
WHERE ((A NOT IN(SELECT C AS A FROM [Sheet1$])) AND (B NOT IN (SELECT D AS B FROM [Sheet1$])))

您可以获得彼此不匹配的记录。

在多列中剪切/粘贴重复值

1 个答案: