Question

我尝试复制活动工作表上的特定范围，然后将这些值添加到同一工作簿中不同工作表上的现有列表中。

完成后，我想删除所有已添加的重复项。

float result = myFunction();
if(result == 99.75f) printf("Error !");

我对VBA很陌生，我可能已经盯着这个问题太长时间了，但我对上述代码没有任何理由。

感谢任何建议。

Answer 1

你可以试试这个

Sub CopyUnique()
    Dim s1 As Worksheet, FirstEmptyRow As Long, expCol As Long
    Set s1 = ActiveSheet
    With Sheets("Products")
        .Range("A:A").Name = "types"
        expCol = .Range("types").Column
        FirstEmptyRow = .Cells(.Rows.Count, expCol).End(xlUp).Row + 1
        s1.Range("C4:C33").Copy .Cells(FirstEmptyRow, expCol)
        .Range("types").RemoveDuplicates Columns:=1, Header:=xlNo
    End With
End Sub

但是从我在代码中看到的内容中，您可以将其缩减为：

Sub CopyUnique()
    Dim s1 As Worksheet
    Set s1 = ActiveSheet
    With Sheets("Products")
        s1.Range("C4:C33").Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        Intersect(.UsedRange, .Columns(1)).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("A" & .Cells(.Rows.Count, 1).End(xlUp)).Name = "types"
    End With
End Sub

Answer 2

您可以在我的个人宏工作簿中试用我已经存放的这个功能：

Function rngToUniqueArr(ByVal rng As Range) As Variant

    'Reference to [Microsoft Scripting Runtime] Required
    Dim dict As New Scripting.Dictionary, cel As Range
    For Each cel In rng.Cells
        dict(cel.Value) = 1
    Next cel
    rngToUniqueArr = dict.Keys

End Function

注意：您需要创建对 Microsoft Scripting Runtime Library
的引用

您将与新子组合使用：

Sub CopyUnique()

    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = ThisWorkbook.ActiveSheet
    Set s2 = ThisWorkbook.Worksheets("Products")

    Dim rngToCopy As Range, valArr() As Variant
    Set rngToCopy = s1.UsedRange.Columns("A")
    valArr = rngToUniqueArr(rngToCopy)

    ' A10 start is an example. You may start at any row by changing the below value
    Dim copyToRng As Range
    Set copyToRng = s2.Range("A10:A" & 10 + UBound(valArr))

    With Application.WorksheetFunction
        copyToRng = .Transpose(valArr)
    End With

End Sub

基本上，使用这个字典，您将创建唯一的“键”并将字典的结果输出到数组。

你需要transpose这个数组的原因是它是一维的。 excel中的一维数组是一条水平线，所以我们这样做是为了使它垂直。您还可以创建一个二维数组以避免使用Transpose，但这样做通常更容易。

VBA - 将列范围值复制到特定工作表，删除重复项

2 个答案: