在列中查找一个单元格值（多个实例），然后将相应的行值复制到另一行（针对其他单元格值）答案

【问题标题】：Look for a cell value (more than one instance) in a column then copy corresponding row values to another row (against other cell value)在列中查找一个单元格值（多个实例），然后将相应的行值复制到另一行（针对其他单元格值）
【发布时间】：2022-06-11 17:45:47
【问题描述】：

我想在单元格（F 列）中查找 Forecast 的值（多个实例 - 唯一键是 Prod 和 Cust），然后将相应的行值复制到另一个单元格中由 Edited Forecast 值标识的其他行（超过一个实例 - 唯一键是 Prod 和 Cust（同一列）。）

这只是复制行值。

Private AutomationObject As Object

Sub Save ()
    Dim Worksheet as Worksheet

    Set Worksheet = ActiveWorkbook.Worksheets("Sheet")
    Worksheet.Range("M18:AX18").Value = Worksheet.Range("M15:AX15").Value
End Sub

【问题讨论】：

欢迎来到 SO。 SO 不是代码编写服务，您必须先进行尝试，在代码尝试中包含您的问题，并解释您的代码有什么问题。如果您已经尝试过，请编辑您的问题并包含您的代码。
我是 VBA 新手
Private AutomationObject As Object Sub Save () Dim Worksheet as Worksheets Set Worksheet = ActiveWorkbook.Worksheets("Sheet") Worksheet.Range("M18:AX18").Value = Worksheet.Range("M15 :AX15").Value End Sub =========== 这是不正确的，我只是在复制 Row 值。 --------------------- 要求是在单元格（F 列）中查找 Forecast 的值（多个实例 - 唯一键是 Prod 和 Cust），并且将相应的行值复制到另一个单元格中由 Edited Forecast 值标识的其他行（多个实例 - 唯一键是 Prod 和 Cust（同一列）。
请不要在评论中发布代码，您可以编辑您的问题并在其中包含您的代码。
在此处检查前 3 名或前 5 名 - 有一个基于函数的答案可能会对您有所帮助。

标签： excel vba

【解决方案1】：

填空（唯一字典）

Option Explicit

Sub FillBlanks()
    
    Const sFirstCellAddress As String = "D3"
    Const sDelimiter As String = "@"
    Const dCols As String = "I:K"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim srg As Range
    Dim rCount As Long
    With ws.Range(sFirstCellAddress)
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Sub
        rCount = lCell.Row - .Row + 1
        Set srg = .Resize(rCount, 2)
    End With
    Dim sData As Variant: sData = srg.Value
    
    Dim drg As Range: Set drg = srg.EntireRow.Columns(dCols)
    Dim dcCount As Long: dcCount = drg.Columns.Count
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim rg As Range
    Dim r As Long
    Dim sString As String
    
    For r = 1 To rCount
        sString = sData(r, 1) & sDelimiter & sData(r, 2)
        If Application.CountBlank(drg.Rows(r)) = dcCount Then
            If dict.Exists(sString) Then
                If IsArray(dict(sString)) Then
                    drg.Rows(r).Value = dict(sString)
                Else
                    dict(sString).Add drg.Rows(r)
                End If
            Else
                Set dict(sString) = New Collection
                dict(sString).Add drg.Rows(r)
            End If
        Else
            If dict.Exists(sString) Then
                If IsArray(dict(sString)) Then
                    'drg.Rows(r).Value = dict(sString) ' overwrite!?
                Else
                    For Each rg In dict(sString)
                        rg.Value = drg.Rows(r).Value
                    Next rg
                    dict(sString) = drg.Rows(r).Value
                End If
            Else
                dict(sString) = drg.Rows(r).Value
            End If
        End If
    Next r
    
    MsgBox "Data updated.", vbInformation
    
End Sub

【讨论】：