我尝试复制活动工作表上的特定范围,然后将这些值添加到同一工作簿中不同工作表上的现有列表中。
完成后,我想删除所有已添加的重复项。
float result = myFunction();
if(result == 99.75f) printf("Error !");
我对VBA很陌生,我可能已经盯着这个问题太长时间了,但我对上述代码没有任何理由。
感谢任何建议。
答案 0 :(得分:2)
你可以试试这个
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
答案 1 :(得分:0)
您可以在我的个人宏工作簿中试用我已经存放的这个功能:
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
,但这样做通常更容易。