在多个列中查找值交集

我在这里深深地理解了这一点：能做到吗？ 如果是的话，我应该考虑哪些方法？

我定期收到一个包含可变数量工作表的电子表格。 每个工作表具有相同的标题行，但下面的行中的值不同。 在一列中是一个标识号码，表示一个唯一的用户，我需要确定这些工作表上的任何标识符列之间是否有交集。 下面是一个简单的例子，其中第一个和第三个工作表有一个abc789的交集，但在Worksheet 2中没有相交的值。我想知道什么时候有交集，以及哪个工作表之间：

工作表1：

身份证号
 •abc123
 •abc456
 •abc789

工作表2：

身份证号
 •abc234
 •abc345
 •abc912

工作表3：

身份证号
 •abc789
 •abc567
 •abc678 

如果可以做到的话，我对另外一个问题感到怀疑：今天以3张纸的方式工作，明天再打10张纸！ 为了回答这个问题，我尝试设置variables为未知数量的列来比较，但显然失败：

Dim iArraySize As Integer Dim iTabCounter As Integer Dim iLoopCounter As Integer iTabCounter = ActiveWorkbook.Sheets.Count For iLoopCounter = 3 To iTabCounter iArraySize = ActiveWorkbook.Sheets(iLoopCounter).Range("C2", Range("C2").End(xlDown)).Count dim aID & iloopcounter as Variant 'this line fails on compile with "expected end of statement" highlighting the ampersand aID1 = Range("C2", Range("C2").End(xlDown)).Value Next iLoopCounter 

这是一个失败的原因？ 我应该解决自己手动检查？

Answer 1

这将输出一个不止一次find的所有ID的列表，以及在汇总表中find了哪些表单：

 Sub tgr() Const strIDCol As String = "A" Const lHeaderRow As Long = 1 Dim cllIDs As Collection Dim ws As Worksheet Dim IDCell As Range Dim arrUnqIDs(1 To 65000) As Variant Dim arrMatches(1 To 65000) As String Dim ResultIndex As Long Dim lUnqIDCount As Long Set cllIDs = New Collection For Each ws In ActiveWorkbook.Sheets With Range(ws.Cells(lHeaderRow + 1, strIDCol), ws.Cells(ws.Rows.Count, strIDCol).End(xlUp)) If .Row > lHeaderRow Then For Each IDCell In .Cells On Error Resume Next cllIDs.Add IDCell.Text, LCase(IDCell.Text) On Error GoTo 0 If cllIDs.Count > lUnqIDCount Then lUnqIDCount = cllIDs.Count arrUnqIDs(lUnqIDCount) = IDCell.Text arrMatches(lUnqIDCount) = ws.Name Else ResultIndex = WorksheetFunction.Match(IDCell.Text, arrUnqIDs, 0) arrMatches(ResultIndex) = arrMatches(ResultIndex) & "|" & ws.Name End If Next IDCell End If End With Next ws If lUnqIDCount > 0 Then With Sheets.Add(Before:=ActiveWorkbook.Sheets(1)) With .Range("A1:B1") .Value = Array("Intersecting ID's", "Intersected in Sheets...") .Font.Bold = True End With .Range("A2").Resize(lUnqIDCount).Value = Application.Transpose(arrUnqIDs) .Range("B2").Resize(lUnqIDCount).Value = Application.Transpose(arrMatches) .UsedRange.AutoFilter 2, "<>*|*" .UsedRange.Offset(1).EntireRow.Delete .UsedRange.AutoFilter .Range("A1").CurrentRegion.EntireColumn.AutoFit End With End If Set cllIDs = Nothing Set ws = Nothing Set IDCell = Nothing Erase arrUnqIDs Erase arrMatches End Sub 

Answer 2

它需要一些工作，但是需要一个脚本来打印列中所有表单上的所有模糊。 它不是非常健壮，你必须指定范围，并打印两次

 Sub printDupes() For Each ws In ActiveWorkbook.Worksheets 'go thru each worksheet For Each idnumber In ws.Range("A2:A4") 'look at each idnumber in id column in selected worksheet For Each otherWs In ActiveWorkbook.Worksheets 'go thru each OTHER worksheet If ws.Name <> otherWs.Name Then 'skip it if its the same sheet For Each otherIdNumber In otherWs.Range("A2:A4") 'go thru each idnumber in the OTHER worksheet (the one you are comparing to) If otherIdNumber.Value = idnumber.Value Then 'if you find a match Debug.Print idnumber.Value 'print the value Debug.Print otherWs.Name & "!" & otherIdNumber.Address 'print the address of the id we were looking at Debug.Print ws.Name & "!" & idnumber.Address 'print address of the match End If Next otherIdNumber End If Next otherWs Next idnumber Next ws End Sub 

这将适用于您的特定示例，用大范围replaceA2：A4

Answer 3

下面的代码将显示消息框，显示工作簿中不同工作表上的相同ID号的位置。 它假定标识符列是列A，而列A中的数据内没有空白单元格

 Sub CheckSub() Const iIDENTIFIER_COLUMN = 1 Dim wsCurrentWorksheet As Worksheet Dim wsWorksheetToCheck As Worksheet Dim lCurrentRow As Long Dim lCheckRow As Long Dim iWorkbookNumber As Integer Dim iWorkbookCount As Integer Dim iCheckbookNumber As Integer iWorkbookCount = ThisWorkbook.Sheets.Count For iWorkbookNumber = 1 To iWorkbookCount lCurrentRow = 2 Set wsCurrentWorksheet = ThisWorkbook.Sheets(iWorkbookNumber) Do While wsCurrentWorksheet.Cells(lCurrentRow, iIDENTIFIER_COLUMN).Value <> Empty For iCheckbookNumber = iWorkbookNumber To iWorkbookCount Set wsWorksheetToCheck = ThisWorkbook.Sheets(iCheckbookNumber) If wsCurrentWorksheet.Name <> wsWorksheetToCheck.Name Then lCheckRow = 2 Do While wsWorksheetToCheck.Cells(lCheckRow, iIDENTIFIER_COLUMN).Value <> Empty If wsCurrentWorksheet.Cells(lCurrentRow, iIDENTIFIER_COLUMN).Value = _ wsWorksheetToCheck.Cells(lCheckRow, iIDENTIFIER_COLUMN).Value Then MsgBox (wsCurrentWorksheet.Cells(lCurrentRow, iIDENTIFIER_COLUMN).Value _ & " found on " & wsCurrentWorksheet.Name & " and " & wsWorksheetToCheck.Name) End If lCheckRow = lCheckRow + 1 Loop End If Next iCheckbookNumber lCurrentRow = lCurrentRow + 1 Loop Next iWorkbookNumber End Sub