[英]Finding duplicates Rows in Excel Table for x values
我实际上是在 Excel 中构建一个数据库,其中工作表是表,列是列,行是记录,目前有点简单。
我做了一个 function 如果 Value1 和 Value2 的记录已经注册在同一行上,则返回 boolean ,以防止重复。
这是我面临的问题:我实际上正在为 3 个值匹配做同样的 Function
必须有一种方法可以根据数组中值的数量动态地使其成为可能。 但我只是坚持下去。
我有 2 个值匹配的初始代码
Function checkDuplicate(ws As Worksheet, value1 As Variant, value2 As Variant) As Boolean
Dim rng As Range
Dim first As Variant
checkDuplicate= False
If (ws.Name <> "UI" And ws.Name <> "Lists") Then
With ws.Range("A:A")
Set rng = .Find(value1)
If Not rng Is Nothing Then
first = rng.Row
Do
If ws.Range("B" & rng.Row).Value = value2 Then
checkDuplicate= True
End If
Set rng = .FindNext(rng)
Loop While rng.Row <> first
End If
End With
End If
End Function
如果我的英语有点糟糕,或者如果有人已经帮助另一个人解决同样的问题,我深表歉意,因为我在搜索时没有找到它。
任何帮助将不胜感激。
如果您正在构建数据库,请考虑使用 SQL
Option Explicit
Sub test()
MsgBox checkDuplicate(Sheet1, Array(1, "ABC", "2021-01-12"))
End Sub
Function checkDuplicate(ws As Worksheet, ar As Variant) As Boolean
Dim cn As Object, cmd As Object, rs As Object
Dim sql As String, arWhere() As String, i As Long
ReDim arWhere(UBound(ar))
For i = 0 To UBound(ar)
arWhere(i) = "[" & ws.Cells(1, i + 1) & "] = ?" '
Next
sql = " SELECT COUNT(*) FROM [" & ws.Name & "$] " & _
" WHERE " & Join(arWhere, " AND ")
Debug.Print sql
'Connecting to the Data Source
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 XML;HDR=YES"";"
.Open
End With
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = cn
.CommandText = sql
For i = 0 To UBound(ar)
.Parameters.Append .CreateParameter(CStr(i), 12, 1) ' adVariant
Next
Set rs = .Execute(, ar)
End With
checkDuplicate = rs(0) > 0
cn.Close
End Function
感谢您的回答
我已经考虑用 SQL 构建一个数据库,遗憾的是这并不真正符合我的需求,因为我存储的数据几乎没有“逻辑链接”,而且非常不同。
没关系,我想通了,但是如果有人知道如何改进它,我觉得这段代码不是很干净,请随时回答!
Function checkDuplicate(ws As Worksheet, valuesArray As Variant) As Boolean
Dim rng As Range
Dim first As Variant
Dim i As Long, j As Long
Dim elements As Long
checkDuplicate = False
elements = UBound(valuesArray) - LBound(valuesArray) + 1
If (ws.Name <> "Interface" And ws.Name <> "Listes") Then
With ws.Range("A:A")
Set rng = .Find(valuesArray(0))
If Not rng Is Nothing Then
first = rng.Row
Do
i = 1
j = 1
Do
If ws.Cells(i + 1, rng.Row).Value = valuesArray(i) Then
i = i + 1
Else
j = j + 1
End If
Loop Until i = elements Or j = elements
If i = elements Then
checkDuplicate = True
GoTo leave
End If
Set rng = .FindNext(rng)
Loop While rng.Row <> first
End If
End With
End If
leave:
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.