在多列中查找值交叉点

I am well out of my depth here: Can this be done? And if so, what methods should I consider?

我在这里深受欢迎:这可以做到吗?如果是这样,我应该考虑哪些方法?

I periodically receive a spreadsheet that contains a variable number of sheets. Each sheet has the same header row, but different values in the rows beneath. In one column is an identifying number that indicates a unique user, and I need to determine if there is an intersection between any of the Identifier columns on those worksheets. Here is a simplified example, in which the first and third worksheet have an intersection of abc789 but there is no intersecting value in Worksheet 2. I want to know when there is an intersection, and between which worksheets:

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

Worksheet 1:

ID_Number
•   abc123
•   abc456
•   abc789

Worksheet 2:

ID_Number
•   abc234
•   abc345
•   abc912

Worksheet 3:

ID_Number
•   abc789
•   abc567
•   abc678

If it can be done, I'm suspicious of another problem: doing it in a way that works for 3 sheets today and 10 sheets tomorrow! To answer that question I tried setting variables for an unknown number of columns to compare like this, but clearly failed:

如果可以做到的话,我怀疑另一个问题:以今天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

Is this a lost cause? Should I resolve myself to manual examination?

这是一个失败的原因吗?我应该解决自己的人工检查吗?

3 个解决方案

#1

This will output a list of all ID's that were found more than once and what sheets they were found in on a summary sheet:

这将输出一个列表,其中列出了多次找到的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

#2

It needs some work but heres a script that will print out all the dupes on all sheets in a column. Its not very robust, you have to specify the range, and it prints everything twice

它需要一些工作,但是一个脚本将打印出列中所有纸张上的所有欺骗。它不是很强大,你必须指定范围,它打印两次

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

this will work for your particular example, replace A2:A4 with a large range

这适用于您的特定示例,用大范围替换A2:A4

#3

The following code will display message boxes showing where the same ID numbers are found on diferent worksheets in the workbook. It assumes the identifier column is column A and that there are no blank cells within the data in column A

以下代码将显示消息框,显示在工作簿中的不同工作表上找到相同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