VBA 提取不重复值? vba字典提取不重复值
Excel 怎么改 用vba代码提取不重复值为数组
前两天正好找到这样一段代码,借你用一下
Dim arr, brr, crr(1 To 70), b As Boolean
b = False
Dim x%: x = 1
arr = ActiveSheet.Range(Cells(1, 1), Cells(70, 1))
brr = ActiveSheet.Range(Cells(1, 2), Cells(70, 2))
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(brr, 1)
If arr(i, 1) = brr(j, 1) Then b = True: Exit For
Next
If b = False Then crr(x) = arr(i, 1): x = x + 1
b = False
Next
ActiveSheet.Cells(1, 3).Resize(x - 1, 1) = Application.Transpose(crr)
VBA抓取相同条件不重复数据
Sub 汇总()
b1 = "sheet1" '''''''''''改为表1的名字
b2 = "sheet2" '''''''''''改为表2的名字
n = Sheets(b2).[a65536].End(xlUp).Row - 1
arr = Sheets(b2).[a2].Resize(Sheets(b2).[a65536].End(xlUp).Row - 1, 2)
h = 1
For i = 2 To Sheets(b1).[a65536].End(xlUp).Row
ReDim arr1(1 To n)
For x = 1 To UBound(arr)
If Sheets(b1).Cells(i, 1) = arr(x, 1) Then
arr1(h) = arr(x, 2)
h = h + 1
End If
Next x
For k = 1 To UBound(arr1)
For k1 = k + 1 To UBound(arr1)
If arr1(k) = arr1(k1) Then
arr1(k1) = ""
End If
Next k1, k
krr = Join(arr1)
krr = Application.Trim(krr)
brr = Split(krr)
krr = Join(brr, ",")
Sheets(b1).Cells(i, 2) = krr
Next i
End Sub
用VBA如何将表1中A列不重复的数据提取到表2B列
方法一
如果数据在A列,A1是第一个,在第一行的空白单元格中输入下面的公式
=IF(COUNTIF(A:A,A1)>1,1,2)
上面的公式是只要是重复的,这个公式的值就为1,2的就不是重复的。
你再用自动筛选,选出来有2的,复制到表2.
方法二
用高级筛选
菜单=数据--筛选--高级筛选--将结果复制到其它位置
列表区域$A:$A
复制到Sheet2!$B:$B
勾,选择不重复记录。
excel 如何多行多列提取不重复的值 vba
方法:
将每一行所有列的内容用特定分隔符连接到一起,作为key存入字典,
重复内容的话,key讥担罐杆忒访闺诗酣涧是相同的,只会有一个值,
这样读完所有行
然后,再用keys方法、split函数将key分解,输出到sheet表