excel - 复制粘贴基于行和列的单元格

Question

我希望我的工作表做的是，当用户更新工作表“Buffy Cast”上的单元格 D3:D8 中的值时，他们可以按下按钮，这些值将被复制到选项卡“实际 FTE”中。 “实际 FTE”选项卡有一个包含多个日期和人员 ID 的表格。代码应根据“Buffy Cast”表中的日期和行 ID 找到列，将数据复制到此位置。
我承认恢复了一些字典代码来查找行，这确实有效，但我在让它查找列时遇到了问题。下面的表格和代码，非常感谢。
验证表

空白统计表

我想在实际情况表上发生什么

最后是我的代码

    Option Explicit

Sub Update()

    Dim wsValidate As Worksheet, wsActual As Worksheet
    Dim lrValidate As Long, lrActual As Long
    Dim i As Long, r As Long, rc As Variant
    Dim n As Long, m As Long

    Dim dict As Object, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    

    Set wsValidate = Worksheets("BuffyCast")
    Set wsActual = Worksheets("ActualFTE")
    
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim lastCol As Long, lastRow As Long, srcRow As Range
    Dim found1 As Range, j As Long, Cr1 As String
 'Find column
    With wsActual
        lastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
        For j = 1 To lastCol
        Cr1 = Worksheets("BuffyCast").Range("D2")
        Set srcRow = .Range("A2", .Cells(2, lastCol))
        Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)
        Next
    End With
 'Make dictionary
    With wsActual
        lrActual = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrActual
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                MsgBox "Duplicate ID No '" & key & "'", vbCritical, "Row " & i
                Exit Sub
            ElseIf Len(key) > 0 Then
                dict.Add key, i
            End If
        Next
    End With

    With wsValidate
        lrValidate = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrValidate
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                r = dict(key)
                wsActual.Cells(r, found1) = .Cells(i, "D")
                    n = n + 1
            Else
                .Rows(i).Interior.Color = RGB(255, 255, 0)
                m = m + 1
            End If
        Next
    End With
    MsgBox n & "Actual FTE Update" & vbLf & m & " rows not found", vbInformation
End Sub

Answer 1

您可以使用 WorksheetFunction.Match method在一行中查找一个值:

Dim Col As Long
On Error Resume Next
Col = Application.WorksheetFunction.Match(wsValidate.Range("D2").Value2, wsActual.Rows(2), 0)
On Error GoTo 0

If Col = 0 Then
    MsgBox "Column was not found", vbCritical
    Exit Sub
End If

' here col has the column number you are looking for
' and you can write to that column like
wsActual.Cells(RowNumber, Col).Value = 123

这将找到 wsValidate.Range("D2") 的值在 wsActual的第二行.