Question

我在这里已经深入了解：这可以做到吗？如果是这样，我应该考虑哪些方法？

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

Worksheet 1:

ID_Number
•   abc123
•   abc456
•   abc789

Worksheet 2:

ID_Number
•   abc234
•   abc345
•   abc912

Worksheet 3:

ID_Number
•   abc789
•   abc567
•   abc678

如果可以做到，我怀疑另一个问题：以今天3张和明天10张的方式做到这一点！为了回答这个问题，我尝试为未知数量的列设置变量以进行比较，但显然失败了：

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

这将输出一个列表，其中包含多次找到的所有ID以及在摘要表中找到它们的工作表：

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

这适用于您的特定示例，将A2：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

在多列中查找值交叉点

3 个答案: