Добавление текущей строки к выводу - PullRequest
1 голос
/ 29 мая 2020

Мне нужна помощь, чтобы найти / задокументировать текущую строку в выходных данных этого макроса. Я не могу поверить в приведенный ниже код, любезный человек @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

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...