VBA Excel :从特定单元格中搜索特定变量值的行,然后将值复制并粘贴到该列的宏
VBA Excel : Macro that searches a row for a certain variable value from specific cell and then copy&pastes value to this column
我过去做过一些 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 "Date Column for " & 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
谢谢。
此致
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 但就是找不到解决这个问题的方法。
我正在寻找一个宏,它在单元格 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 "Date Column for " & 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
谢谢。
此致
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