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