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

将其放在此处，因为我不想发表评论。为什么不能使用工作表更改事件？您可以将目标范围设置为多个范围。将此代码放在包含您在示例中显示的两个区域的工作表中。当一个单元格中的值更改时，它将自动更新右侧的三个单元格。

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

Answer 2

我认为现有答案（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，并且是相对于范围而不是工作表的（即黄色单元格中的第一行，而不是工作表的第一行）。 / p>

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

不匹配和匹配问题

2 个答案: