Я пытался работать с вашим исходным кодом, но, честно говоря, очень запутался. В моем примере ниже будут показаны некоторые практические приемы, которые могут помочь (а также те, кто может просмотреть ваш код позже, включая вас самих!). Итак, вот список комментариев:
- Всегда используйте
Option Explicit. Возможно, в вашем коде это уже есть, но я перечисляю его здесь для полноты картины. - Создайте имена переменных, которые описывают, какие данные в нем содержатся. Ваш код делает это немного, но некоторые имена переменных трудно вписать в поток logi c. Моя идея в программировании - это всегда пытаться писать самодокументированный код. Таким образом, почти всегда ясно, что код пытается выполнить sh. Затем я воспользуюсь комментарием для блоков кода, где он может быть менее ясным. (Не попадайтесь в ловушку, добавляя к именам переменных префикс «типа» или что-то в этом роде; в конечном итоге это того не стоит.)
- Четкое описание проблемы всегда помогает. Это верно не только для получения помощи по SO, но и для вас самих. Мой последний комментарий к вашему сообщению выше, спрашивающий об описании проблемы, действительно все упростил. Это включает в себя описание того, что вы хотите, чтобы ваш вывод отображал.
В соответствии с описанием проблемы вам необходимо идентифицировать каждый уникальный элемент и отслеживать, в какой строке вы найдете этот элемент, чтобы вы могли создать отчет позже . A Dictionary - идеальный инструмент для этого. Прочтите о том, как использовать Dictionary, но вы должны иметь возможность следить за тем, что делает этот блок кода здесь (даже без всех предыдущих объявлений):
For Each cell In dataArea.Cells
If Not IsEmpty(cell) Then
If items.Exists(cell.Value) Then
'--- add this row to the list
rowList = items(cell.Value) & "," & cell.Row
items(cell.Value) = rowList
Else
'--- first time adding this value
items.Add cell.Value, cell.Row
End If
End If
Next cell
Легко увидеть, как logi c этого кода следует за описанием проблемы. После этого нужно просто просмотреть каждую строку в области данных и проверить каждое значение в этой строке, чтобы увидеть, существуют ли дубликаты в любой другой строке. Полный пример решения приведен ниже, чтобы вы могли изучить его и приспособить к своей ситуации.
Option Explicit
Sub IdentifyMatches()
Dim ws As Worksheet
Set ws = Sheet1
Dim dataArea As Range
Set dataArea = ws.Range("A1:F6")
Dim items As Dictionary
Set items = New Dictionary
'--- build the data set of all unique items, and make a note
' of which row the item appears.
' KEY = cell value
' VALUE = CSV list of row numbers
Dim rowList As String
Dim cell As Range
For Each cell In dataArea.Cells
If Not IsEmpty(cell) Then
If items.Exists(cell.Value) Then
'--- add this row to the list
rowList = items(cell.Value) & "," & cell.Row
items(cell.Value) = rowList
Else
'--- first time adding this value
items.Add cell.Value, cell.Row
End If
End If
Next cell
'--- now work through the data, row by row and make the report
Dim report As String
Dim duplicateCount As Variant
ReDim duplicateCount(1 To dataArea.Rows.Count)
Dim dataRow As Range
For Each dataRow In dataArea.Rows
Erase duplicateCount
ReDim duplicateCount(1 To dataArea.Rows.Count)
Dim rowNumber As Variant
For Each cell In dataRow.Cells
If items.Exists(cell.Value) Then
rowList = items(cell.Value)
Dim rowNumbers As Variant
rowNumbers = Split(rowList, ",")
For Each rowNumber In rowNumbers
If rowNumber <> cell.Row Then
duplicateCount(rowNumber) = duplicateCount(rowNumber) + 1
End If
Next rowNumber
End If
Next cell
report = vbNullString
For rowNumber = 1 To UBound(duplicateCount)
If duplicateCount(rowNumber) > 0 Then
report = report & rowNumber & "(" & duplicateCount(rowNumber) & ")" & ", "
End If
Next rowNumber
'--- display the report in the next column at the end of the data area
If Len(report) > 0 Then
report = Left$(report, Len(report) - 2) 'removes the trailing comma and space
dataRow.Cells(1, dataRow.Columns.Count + 1).Value = report
End If
Next dataRow
End Sub