Option Explicit
Sub GetDistinctRecords()
Dim strConnection As String
Dim strQuery As String
Dim objConnection As Object
Dim objRecordSet As Object
Select Case LCase(Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".")))
Case ".xls"
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 8.0;HDR=YES;"";"
Case ".xlsm", ".xlsb"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 12.0 Macro;HDR=YES;"";"
End Select
strQuery = "SELECT DISTINCT * FROM [Sheet1$]"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = objConnection.Execute(strQuery)
RecordSetToWorksheet Sheets(2), objRecordSet
objConnection.Close
End Sub
Sub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)
Dim i As Long
With objSheet
.Cells.Delete
For i = 1 To objRecordSet.Fields.Count
.Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset objRecordSet
.Cells.Columns.AutoFit
End With
End Sub
strQuery = "SELECT CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country FROM [Sheet1$] GROUP BY CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country HAVING Count(*) > 1"
Public Function InCollection(Col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.clear
On Error Resume Next
var = Col.Item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function
Option Explicit
Private d As Scripting.Dictionary
Private Sub Class_Initialize()
Set d = New Scripting.Dictionary
End Sub
Public Sub Add(var As Variant)
d.Add var, 0
End Sub
Public Function Exists(var As Variant) As Boolean
Exists = d.Exists(var)
End Function
Public Sub Remove(var As Variant)
d.Remove var
End Sub
然后你可以这样使用它:
mdl主视图
Public Sub Main()
Dim s As clsSet
Set s = New clsSet
Dim obj As Object
s.Add "A"
s.Add 3
s.Add #1/19/2017#
Debug.Print s.Exists("A")
Debug.Print s.Exists("B")
s.Remove #1/19/2017#
Debug.Print s.Exists(#1/19/2017#)
End Sub
Private Sub testset()
' set up an array to hold source values
Dim values()
values = Array("Item1", "Item2", "Item1")
' declare a collection
Dim col As New Collection
' loop through the array and add items with the key string
For Each item In values
On Error Resume Next
' ignore the error raised if the key is already present
col.Add item:=item, Key:=item
On Error GoTo 0
Next
' loop through the set
For Each item In col
Debug.Print item
Next
End Sub
4条答案
按热度按时间bqf10yzr1#
看一下.NET ArrayList,它有
Add
、Contains
、Sort
等方法,可以在VBS和VBA环境中示例化对象:Scripting.Dictionary
也可以满足需要,它具有唯一的键,Exists
方法允许检查键是否已经在字典中。但是,在这种情况下,通过ADODB的SQL请求可能会更有效。以下示例显示了如何通过对工作表的SQL查询来检索唯一行:
源数据应该放在
Sheet1
上,结果输出到Sheet2
。该方法的唯一限制是ADODB连接到驱动器上的Excel工作簿,因此任何更改都应该在查询之前保存以获得实际结果。如果您只想获取非唯一行的集合,那么查询应该如下所示(仅举一个例子,您必须将您的字段集合放入查询中):
uurity8g2#
您可以使用集合并执行以下函数,集合强制使用唯一键标识符:
du7egjpx3#
只需为
Scripting.Dictionary
编写一个 Package 器,只公开类似于集合的操作。类集
然后你可以这样使用它:
mdl主视图
按预期打印True、False和False。
neekobn84#
如果在添加
Collection
时随Item
一起提供Key
,则Collection
将被编入索引。请注意,虽然项可以是任何类型的对象,但键必须是字符串。输出: