基於行和列復制粘貼單元格

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 方法在一行中查找值：

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

這將在 wsActual 的第二行找到wsActual wsValidate.Range("D2")的值。