VBA Excel：宏，該宏在一行中搜索特定單元格中的某個變量值，然后將值復制並粘貼到此列中

Question

我過去曾做過一些VBA，但無法為此找到解決方案。

我正在尋找一個宏，該宏從單元格C4到Z4（從C4開始的一個無限長行）中搜索一個每周更改的單元格B4的值（數字）。 如果找到匹配項，則將單元格B5到B100的值（從B5開始的一個無限長列）復制並粘貼到正確的C到Z列（從C5等向下）中。

對於正確的列，我的意思是宏在其中找到B4和C4與Z4之間匹配的列。 C4至Z4不相同。

我經過漫長而艱苦的搜索，發現的最接近的是： 宏，該宏在單元格中查找值，然后將范圍粘貼到該單元格的列中。 2007年卓越

但是，它對我不起作用。 該線程中的解決方案說，匹配的單元格值應為日期格式。 我重新構造了所有這些內容，但是即使使用日期而不是數字也無法正常工作。 宏總是根據VBA行給出消息

MsgBox“＆CStr（[B2] .Value）和”找不到“的日期列

因此，即使我在匹配的單元格中以相同的日期運行它，也找不到適合我的匹配項。 （我當然將此宏更改為我的單元格位置）

這個論壇是我最后的嘗試:)

我有以下代碼不起作用：

Private Sub CommandButton2_Click()

Dim ws As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim cl As Range
Dim dat As Variant

Set ws = ActiveSheet

' Get the Source range
Set rSrc = ws.Range([B5], ws.Columns(2).Cells(ws.Rows.Count, 1).End(xlUp))
dat = rSrc

' Find the Destination column and copy data
Set rDst = ws.Range([D4], ws.Rows(1).Cells(1, ws.Columns.Count).End(xlToLeft))
Set cl = rDst.Find(What:=[B4], _
  After:=rDst.Cells(1, 1), _
  LookIn:=xlValues, _
  LookAt:=xlWhole, _
  SearchOrder:=xlByRows, _
  SearchDirection:=xlNext)
If cl Is Nothing Then
    MsgBox "Column for " & CStr([B4].Value) & " Not Found"
Else
    Set rDst = cl.Offset(1, 0).Resize(UBound(dat, 1), 1)
    rDst = dat
End If

End Sub

謝謝。

問候

Answer 1

Sub FindandCopy
Dim what as range
dim where as range
dim found as range
set what = range("b4")  'what we're looking for
set where = range("c4")  'start of search range
do
if where = what then 
    set found = where  'that's where we found it
else
 set where = where.offset(0,1) 'otherwise keep looking
end if
loop until where = ""   'stop if blank
if found = "" then  'we fell off the end
      msgbox what & " not found "
else
      range(range("b5"),range("b5").end(xldown)).copy 
      found.offset(1,0).pastespecial xlpastevalues
end if
end sub