Мне нужна помощь, чтобы найти / задокументировать текущую строку в выходных данных этого макроса. Я не могу поверить в приведенный ниже код, любезный человек @Variatus предоставил основную часть кода. Он работает почти так, как мне нужно. Код сравнивает каждую строку друг с другом и ищет совпадения в отдельных столбцах. В настоящее время вывод кода - 2 числа на совпадение «#, #» . Первое число - это строка, которой соответствует «текущая» строка. Второе число - это количество совпадений, общих для строк. Код делает это построчно, сравнивая со всеми строками. Таким образом, на выходе может быть несколько пар. Чтобы отличить guish разные совпадения друг от друга, «пары» разделяются пробелом. Я пытаюсь включить в выходные значения текущую строку, в которой он находится. Это означает, что должно быть три выхода, если есть совпадение… current_row, matched_row, number_of_matched_values. В дополнение к включению текущей строки мне также нужен весь вывод в список в 3 столбца (Столбец_1 = текущая_строка, Столбец_2 = согласованная_строка и Столбец_3 = число_согласованных_значений). Я попытался выполнить печать в непосредственном окне с помощью Debug.Print R. Поскольку я изначально не создавал этот код, я не уверен, где и где текущая строка хранится в переменных / массивах. * PS: буквенно-цифровая c информация (Буква ##) - это мой способ поместить уникальное значение в ячейки, в которых нет важной информации. Данные взяты из функции index_match из другой таблицы. Tmp - это количество совпадений, которые нужно искать в каждой строке. Также может не быть совпадений подряд, это возможный результат.
Const TopLeftCell As String = "A8" ' change to match where your data are
Dim Rng As Range ' data range
Dim FirstRow As Long, FirstClm As Long
Dim Data As Variant ' original data (2-D)
Dim Arr As Variant ' data rearranged (1-D)
Dim Tmp As Variant ' working variable
Dim R As Long, R1 As Long ' row counters
Dim C As Long ' column counter
Dim Count() As String ' match counter
With Range(TopLeftCell)
FirstRow = .Row
FirstClm = .Column
End With
C = Cells(FirstRow, Columns.Count).End(xlToLeft).Column
' Set Rng = Range(Cells(FirstRow, FirstClm), _
' Cells(Rows.Count, FirstClm).End(xlUp).Offset(0, C - FirstClm))
'^^Don't Use!!!!!
Set Rng = Range(Cells(FirstRow, FirstClm), Cells(13, 8)) '13 is the last row in the data and 8 is the number of columns
Data = Rng.Value
ReDim Arr(1 To UBound(Data))
For R = 1 To UBound(Data)
ReDim Tmp(1 To UBound(Data, 2))
For C = 1 To UBound(Data, 2)
Tmp(C) = Data(R, C)
Next C
Arr(R) = Tmp
Next R
ReDim Count(1 To UBound(Arr))
For R = 1 To UBound(Arr) - 1
For R1 = R + 1 To UBound(Arr)
Tmp = 0
For C = 1 To UBound(Arr(R))
If Not IsError(Application.Match(Arr(R)(C), Arr(R1), 0)) Then
Tmp = Tmp + 1
End If
Next C
If Tmp >= 1 Then ' change to suit
Tmp = Format(Tmp, ",0") & ", "
Count(R) = Count(R) & CStr(R1 + FirstRow - 1) & Tmp
Count(R1) = Count(R1) & CStr(R + FirstRow - 1) & Tmp
End If
Next R1
Next R
For R = 1 To UBound(Count)
If Len(Count(R)) Then Count(R) = Left(Count(R), Len(Count(R)) - 2)
Next R
' set the output column here (2 columns right of the last data column)
' to avoid including this column in the evaluation
' it must be blank before a re-run
Set Rng = Rng.Resize(, 1).Offset(0, UBound(Data, 2) + 1)
Rng.Value = Application.Transpose(Count)
End Sub