Question

我过去曾经做过一些VBA，但只是找不到解决方案。

我正在寻找一个宏，该宏从单元格C4到Z4（从C4开始的无限长行）中搜索单元格B4中每周更改的值（数字）。如果找到匹配项，则将单元格B5到B100（从B5开始的一个无限长列）的值复制并粘贴到正确的C到Z列（从C5等向下）中。

正确的列是指宏在其中找到B4和C4到Z4之间的匹配项的列。 C4至Z4不相同。

我经过漫长而艰苦的搜索，发现的最接近的是： Macro that looks for a value in a cell & then paste a range in the column of that cell. EXCEL 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

VBA Excel：宏，该宏在一行中搜索特定单元格中的某个变量值，然后将值复制并粘贴到此列

1 个答案: