时间戳

首页 > 解决方案 > 比较 2 个范围将新项目添加到范围末尾

excel - 比较 2 个范围将新项目添加到范围末尾

问题描述

我在 D 列中有一个范围，在 F 列中有一个范围。这些范围包含字符串，D 列中的字符串是唯一的（即它们不重复），F 列中的字符串也是唯一的。但是，D 列和 F 列在大多数情况下都应该包含相同的字符串，尽管它们的顺序可能不同。字符串看起来类似于：

tag:(0004)X-axis
tag:(0005)Z-axis
tag:(0005)X-axis
tag:(0006)Z-axis

有时 D 列可能缺少一些字符串，或者它可能有一些新字符串。我想将 D 列与 F 列进行比较，如果 D 列中有新字符串，我想将它们添加（附加）到 F 列的末尾。这是一个简单的示例，仅使用 a、b、c 而不是“标签:(00...bla...bla...":

Column D    Column F
a           b
b           c
c           d
e           e
f           g
g

D 列缺少“d”但有“a”和“f”......因此“a”和“f”将被添加（附加）到 F 列的末尾，如下所示：

Column F
b
c
d
e
g
a
f

我试图将其用作不太直接的路线，但我什至无法使其工作：

Sub RT_COMPILER()

Dim Lastrow As Long
Dim r As Long
Dim n As Long

For r = 1 To Lastrow
    n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))
    If n = 0 Then
        Cells(r, 7) = Cells(r, 4)
    Else
        Cells(r, 7) = ""
    End If
Next

End Sub

我的想法是：如果我可以将新字符串放入 G 列...然后删除空格，然后将它们复制并粘贴到 F 列的末尾...但它似乎只是识别列中的最后一项D 是“g”，F 列中的最后一项是空白的，即使它已经有一个“g”，它也会从列表中拉出一个“g”......

当我最初发现这段代码时，它有：

n = Application.WorksheetFunction.CountIf("D:D", Cells(r, 6))

它没有用，所以我将其更改为：

n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))

标签： excelvbafor-loopstring-comparison

解决方案

我认为您CountIf在错误的列中查找。

我推荐以下方法：

Option Explicit

Public Sub CompareAndAppend()
    Dim ws As Worksheet 'define worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    Dim NextFreeRow As Long
    NextFreeRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 1

    Dim cnt As Long

    Dim iRow As Long
    For iRow = 1 To LastRow 'loop through column D
        cnt = Application.WorksheetFunction.CountIf(ws.Range("F:F"), ws.Cells(iRow, "D"))
        If cnt = 0 Then 'this value is missing in F, append it
            ws.Cells(NextFreeRow, "F").Value = ws.Cells(iRow, "D")
            NextFreeRow = NextFreeRow + 1 'move to next free row
        End If
    Next iRow
End Sub

在此处输入图像描述

添加了红色的。

一个可能更快的版本是使用数组和字典：

Public Sub CompareAndAppendSpeedyGonzales()
    Dim ws As Worksheet 'define worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim InputArr() As Variant
    InputArr = ws.Range("D1", ws.Cells(ws.Rows.Count, "D").End(xlUp)).Value

    Dim CompareArr() As Variant
    CompareArr = ws.Range("F1", ws.Cells(ws.Rows.Count, "F").End(xlUp)).Value

    Dim AppendArr As Variant

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    'add column F
    For i = LBound(CompareArr, 1) To UBound(CompareArr, 1)
        If Not dict.exists(CompareArr(i, 1)) Then
            dict.Add CompareArr(i, 1), 0
        End If
    Next i

    'add column D
    For i = LBound(InputArr, 1) To UBound(InputArr, 1)
        If Not dict.exists(InputArr(i, 1)) Then
            dict.Add InputArr(i, 1), 0
            If IsEmpty(AppendArr) Then
                ReDim AppendArr(1 To 1)
                AppendArr(1) = InputArr(i, 1)
            Else
                ReDim Preserve AppendArr(1 To UBound(AppendArr) + 1)
                AppendArr(UBound(AppendArr)) = InputArr(i, 1)
            End If
        End If
    Next i

    ws.Cells(ws.Rows.Count, "F").End(xlUp).Offset(1, 0).Resize(RowSize:=UBound(AppendArr)).Value = Application.WorksheetFunction.Transpose(AppendArr)
End Sub

推荐阅读