3

我在这里完全超出了我的深度：可以这样做吗？如果是这样，我应该考虑什么方法？

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

工作表 1：

身份证号
• abc123
• abc456
• abc789

工作表 2：

身份证号
• abc234
• abc345
• abc912

工作表 3：

身份证号
• 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

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

4

3 回答 3

3

这将输出不止一次找到的所有 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
于 2013-08-16T04:19:09.507 回答
1

它需要一些工作，但这里有一个脚本，它将打印出列中所有工作表上的所有欺骗。它不是很健壮，您必须指定范围，并且它会打印所有内容两次

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 替换为大范围

于 2013-08-16T03:55:47.953 回答
1

以下代码将显示消息框，显示在工作簿的不同工作表上找到相同 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
于 2013-08-16T04:07:53.060 回答