搜索复制的值MACRO



我有两张纸:

  1. 数据库

  2. 宏工作表:它有一行,其中的日期将作为宏之后表格的标题。

目标:在宏工作表中,获取第一个日期的值,并查找其在数据库工作表中的位置。然后,在数据库工作表中,复制与先前复制的日期相对应的整列。

我知道代码应该是这样的:

Sheets("Macro").Select
Range("K3").Select
Selection.Copy
Sheets("Database").Select
Cells.Find(What:=Selection.PasteSpecial xlValues, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro").Select
ActiveSheet.Paste

这个代码不起作用,因为搜索部分做得不好,我会感谢的一些更正

沿着这些线的东西。

阅读本文,了解不使用"选择"或"激活"的优点。

使用Find时,请始终首先检查是否找到了您的搜索词,以避免出现错误。例如,不能激活不存在的单元格。

Sub x()
Dim r As Range
With Sheets("Database")
Set r = .Cells.Find(What:=Sheets("Macro").Range("K3").Value, lookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
Range(r, r.End(xlDown)).Copy Sheets("Macro").Range("A1")
End If
End With
End Sub

循环宏工作表中的标题日期。如果在"数据库"工作表的标题行中可以找到任何列,请将该列复制到标题下的"宏"工作表中。

sub getDateData()
dim h as long, wsdb as worksheet, m as variant, arr as variant
set wsdb = worksheets("database")
with worksheets("macro")
for h=1 to .cells(1, .columns.count).end(xltoleft).column
m = application.match(.cells(1, h).value2, wsdb.rows(1), 0)
if not iserror(m) then
arr = wsdb.range(wsdb.cells(2, m), wsdb.cells(rows.count, m).end(xlup)).value
.cells(2, h).resize(ubound(arr, 1), ubound(arr, 2)) = arr
end if
next h
end with
end sub

最新更新