我希望我的工作表做的是,当用户更新工作表“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
最佳答案
您可以使用 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
的第二行.
关于excel - 复制粘贴基于行和列的单元格,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/71847868/