Несоответствие и проблема соответствия

Question

У меня есть код, который ничего не пишет.Я получаю проблему с соответствием, и ошибка несоответствия в строке кода ниже

rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")

выделена желтым цветом.

Чтобы быстро объяснить код и использовать изображение Excelниже ожидаемого письменного результата находится серая подсветка в ячейках F8, G8, H8.Данные, которые записываются в эти ячейки, появляются только тогда, когда любой набор чисел записывается в диапазон ячеек, E6: E17 и только потом.Источник данных от ячеек M5 до O17.Таким образом, в качестве примера, когда ячейка E8 (3-я строка вниз) содержит 10-1, код будет выполнять поиск источника данных (3-я строка вниз) и записывать данные из ячеек источника данных M8 / N8 / O8 в ячейки F8 / G8 / H8.,

Пожалуйста, не предлагайте использовать формулу, потому что в arr1 и arr2 я буду использовать около 50 или более диапазонов.Я только хочу использовать этот код и мне просто нужна помощь с внесением необходимых корректировок смещения и соответствия.

Sub PlaceNumbers()

    Dim c As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim last1 As Long, last2 As Long, rtar As Long, xtar As Long

    Application.ScreenUpdating = False

    With ActiveSheet
        'create arrays
        arr1 = Array(.Range("D5:H17"))
        arr2 = Array(.Range("L5:O17))                                                             '
        'loop through arrays
        For i = LBound(arr1) To UBound(arr1)
            Set rng1 = arr1(i)
            Set rng3 = arr2(i)                                                      
            last1 = .Cells(.Rows.Count, ColLetter(rng1.Columns(1).Column)).End(xlUp).Row
            last2 = .Cells(.Rows.Count, ColLetter(rng3.Columns(1).Column)).End(xlUp).Row

            For Each c In rng1.Offset(1, 1).Resize(, 1)
                If c <> "" Then
                    rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")
                    xtar = Application.Match(c.Offset(0, -2), Range(ColLetter(rng3.Columns(1).Column) & rtar & ":" & ColLetter(rng3.Columns(1).Column) & last2), 0)
                    With Application.WorksheetFunction
                        c.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
                        c.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)
                        c.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
                    End With
                End If
            Next c
        Next
    End With

    Application.ScreenUpdating = True

End Sub

Function ColLetter(Collet As Integer) As String

    ColLetter = Split(Cells(1, Collet).Address, "$")(1)

End Function

Exec image

Answer 1

Я думаю, что существующий ответ (https://stackoverflow.com/a/55959955/8811778) лучше (если он делает то, что вам нужно), так как он короче и проще в обслуживании / отладке.

Но я включаю альтернативную, более длинную версию ниже.

---

Если единственная логика / правило, которое приводит к записи значений в M8:O8 в F8:H8, - это «количество строк вниз» (т.е. на 3 строки вниз), то я не думаю, что вам действительно нужно использовать MATCH функция.

Если я правильно понимаю, вам просто нужна строка Nth исходных данных, где N соответствует строке любой непустой ячейки (в желтых ячейках), которую вы сейчас обрабатываете.

Если вы измените свой For each c in rng1.Offset(1, 1).Resize(, 1), чтобы вместо этого циклически проходить по желтым ячейкам по одной строке за раз, у вас будет доступ к N (в противном случае вам потребуется выполнить некоторую арифметику строк: c.Row - first row of yellow cells + etc...).

Обратите внимание, что N является переменной rowIndexRelativeToRange в приведенном ниже коде и относится к диапазону, а не к рабочему листу (т.е. первая строка в желтых ячейках, а не первая строка рабочего листа).

Option Explicit

Sub PlaceNumbers()

    Dim someSheet As Worksheet
    Set someSheet = ActiveSheet ' Refer to this sheet by name if possible

    With someSheet
        Dim arr1 As Variant
        arr1 = Array(.Range("D5:H17"))

        Dim arr2 As Variant
        arr2 = Array(.Range("L5:O17"))
    End With

    'Application.ScreenUpdating = False ' Uncomment when you think code is ready/working

    Dim i As Long
    Dim rng1 As Range, rng2 As Range
    For i = LBound(arr1) To UBound(arr1)
        Set rng1 = arr1(i)
        Set rng2 = arr2(i)

        ' We have to resize the ranges (to get rid of the first row and first column)
        ' You may want to re-think whether the addresses you specify (when creating arr1 and arr2)
        ' even need to include the first row and first column (e.g. E6:H17 instead of D5:H17)
        ' -- or whether you could just ensure the address passed in already excludes the first row and first column.
        ' It depends on whether you need to use the first row and first column (somewhere else in your code).
        ' But precluding them (if possible) would shorten/simplify the procedure's logic.

        Dim inputColumn As Range
        Set inputColumn = rng1.Offset(1, 1).Resize(rng1.Rows.Count - 1, 1) ' -1 when resizing, otherwise you're looking at range E6:E18, not E6:E17

        Dim dataSourceRange As Range
        Set dataSourceRange = rng2.Offset(1, 1).Resize(rng2.Rows.Count - 1, rng2.Columns.Count - 1)

        Dim rowIndexRelativeToRange As Long ' This index is 1-based and relative to the range, not the worksheet.
        For rowIndexRelativeToRange = 1 To inputColumn.Rows.Count
            If inputColumn(rowIndexRelativeToRange, 1) <> "" Then
                inputColumn(rowIndexRelativeToRange, 1).Offset(0, 1).Resize(, 3).Value = dataSourceRange(rowIndexRelativeToRange, 1).Resize(, 3).Value
            End If
        Next rowIndexRelativeToRange
    Next i

    'Application.ScreenUpdating = True ' Uncomment when you think code is ready/working

End Sub

Answer 2

Поместите это здесь, потому что я не хочу оставлять комментарии.Почему вы не можете использовать событие смены листа?Вы можете установить целевой диапазон на несколько диапазонов.Поместите этот код на лист, содержащий две области, которые вы показали в своем примере.Когда значение в ячейке изменяется, оно автоматически обновляет три ячейки вправо.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E6:E17")) Is Nothing Then
        Range(Target.Address).Offset(, 1).Resize(1, 3).Value = Range(Target.Address).Offset(, 8).Resize(1, 3).Value
    End If
End Sub