如何仅使用一个单元格中的数据来获取列中的特定数据
How to get specific data in a column by only using data from one cell
我有很多销售订单,我必须填写来自不同 excel 工作簿和工作表的大量数据。所以我需要一个可以为我做的宏。我有 4 个不同的 Excel 工作簿。 1 必须插入数据的位置和 3 我必须从中获取数据的位置。所有 Excel 工作簿都列出了销售订单,
因此宏必须扫描每个工作簿中的每个销售订单,然后从工作簿中获取特定数据。
这是我粘贴数据的工作簿示例。
这是我必须复制数据的工作簿示例。
所以它必须复制:
然后将其粘贴到我要粘贴数据的工作簿中。
如果有人能给我一个开始的地方或一些代码,我会非常高兴!
下面的编辑解决方案。不是最漂亮的代码,可能有更好的方法来实现它,但它应该以一种迂回的方式做你想做的事。
将此宏复制到您正在复制 TO 的主簿中的模块中,并将其保存为 XLSM 文件。
将要复制的所有 3 张(或任意多张)FROM 放在不同的文件夹中然后将该文件位置插入宏中注明的位置。
这应该遍历指定位置的每个文件,抓取除 header 行以外的所有已用单元格,并将它们粘贴到母版簿 Sheet2 中的下一个可用行中。
然后宏将 运行 根据销售订单号对复制的数据进行 vlookup,并粘贴特殊内容以将其恢复为值。最后它将清除 Sheet2 以备下次使用 运行。
显然,如果您的工作表被命名为其他名称,您可以修改或按编号引用它们,但它至少应该给您一个起点。
Sub CopyTheData()
Dim Folder As String
Dim File As Variant
Dim wbk As Workbook
Dim This As Worksheet, That As Worksheet
Folder = "[FOLDER LOCATION HERE]"
File = Dir(Folder & "*.*")
Set This = ThisWorkbook.Sheets(1)
Set That = ThisWorkbook.Sheets(2)
Application.ScreenUpdating = False
While (File <> "")
Set wbk = Workbooks.Open(Folder & File)
With wbk
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=That.Range("B65536").End(xlUp)(2).Offset(0, -1)
End With
wbk.Close
File = Dir
Wend
This.Activate
This.Range("B2", Range("A2").End(xlDown).Offset(0, 1)).Formula = "=VLOOKUP(A2, Sheet2!$A:$H,2,FALSE)"
This.Range("C2", Range("A2").End(xlDown).Offset(0, 2)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,4,FALSE)"
This.Range("D2", Range("A2").End(xlDown).Offset(0, 3)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,6,FALSE)"
This.Range("E2", Range("A2").End(xlDown).Offset(0, 4)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,8,FALSE)"
With This.Range("B2", Range("A2").End(xlDown).Offset(0, 4))
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Columns("D:E").NumberFormat = "m/d/yyyy"
That.Cells.ClearContents
Application.ScreenUpdating = True
End Sub
Harley 的代码看起来不错,如果您只想使用某些 sheet,尽管您可以将以下内容粘贴到每个要添加到主 sheet 的 sheet 中].
Dim owb As Workbook
Dim Master As Worksheet
Dim Slave As Worksheet 'the following declares both master and slave as worksheets
fpath = "location of master workbook"
Set owb = Application.Workbooks.Open(fpath) 'opens the file path
Set Master = ThisWorkbook.Worksheets("name of sheet in workbook your pasting from") 'declares this workbook and sheet as "master"
Set Slave = owb.Worksheets("name of sheet in master you are pasting to") 'declares the workbook and sheet you're copying to as "slave"
For j = 1 To 10000 '(the master sheet) 'goes through each row from 1 to 10000
For i = 1 To 10000 '(the slave sheet) 'again does the same and the slave sheet
If Trim(Master.Cells(j, 4).Value2) = vbNullString Then Exit For 'if the ID is blank it will exit and move on to the next row
If Master.Cells(j, 1).Value = Slave.Cells(i, 1).Value Then 'the 1 represents column A, if cell in column A matches the cell in column D in the masterwork book then it will..
Slave.Cells(i, 2).Value = Master.Cells(j, 2).Value
'the cell here represent column B as it's a 2, you can change and add as many as you like to bring through the column
End If
Next
Next
MsgBox ("Successful")
我有很多销售订单,我必须填写来自不同 excel 工作簿和工作表的大量数据。所以我需要一个可以为我做的宏。我有 4 个不同的 Excel 工作簿。 1 必须插入数据的位置和 3 我必须从中获取数据的位置。所有 Excel 工作簿都列出了销售订单,
因此宏必须扫描每个工作簿中的每个销售订单,然后从工作簿中获取特定数据。
这是我粘贴数据的工作簿示例。
这是我必须复制数据的工作簿示例。
所以它必须复制:
然后将其粘贴到我要粘贴数据的工作簿中。
如果有人能给我一个开始的地方或一些代码,我会非常高兴!
下面的编辑解决方案。不是最漂亮的代码,可能有更好的方法来实现它,但它应该以一种迂回的方式做你想做的事。
将此宏复制到您正在复制 TO 的主簿中的模块中,并将其保存为 XLSM 文件。
将要复制的所有 3 张(或任意多张)FROM 放在不同的文件夹中然后将该文件位置插入宏中注明的位置。
这应该遍历指定位置的每个文件,抓取除 header 行以外的所有已用单元格,并将它们粘贴到母版簿 Sheet2 中的下一个可用行中。
然后宏将 运行 根据销售订单号对复制的数据进行 vlookup,并粘贴特殊内容以将其恢复为值。最后它将清除 Sheet2 以备下次使用 运行。
显然,如果您的工作表被命名为其他名称,您可以修改或按编号引用它们,但它至少应该给您一个起点。
Sub CopyTheData()
Dim Folder As String
Dim File As Variant
Dim wbk As Workbook
Dim This As Worksheet, That As Worksheet
Folder = "[FOLDER LOCATION HERE]"
File = Dir(Folder & "*.*")
Set This = ThisWorkbook.Sheets(1)
Set That = ThisWorkbook.Sheets(2)
Application.ScreenUpdating = False
While (File <> "")
Set wbk = Workbooks.Open(Folder & File)
With wbk
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=That.Range("B65536").End(xlUp)(2).Offset(0, -1)
End With
wbk.Close
File = Dir
Wend
This.Activate
This.Range("B2", Range("A2").End(xlDown).Offset(0, 1)).Formula = "=VLOOKUP(A2, Sheet2!$A:$H,2,FALSE)"
This.Range("C2", Range("A2").End(xlDown).Offset(0, 2)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,4,FALSE)"
This.Range("D2", Range("A2").End(xlDown).Offset(0, 3)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,6,FALSE)"
This.Range("E2", Range("A2").End(xlDown).Offset(0, 4)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,8,FALSE)"
With This.Range("B2", Range("A2").End(xlDown).Offset(0, 4))
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Columns("D:E").NumberFormat = "m/d/yyyy"
That.Cells.ClearContents
Application.ScreenUpdating = True
End Sub
Harley 的代码看起来不错,如果您只想使用某些 sheet,尽管您可以将以下内容粘贴到每个要添加到主 sheet 的 sheet 中].
Dim owb As Workbook
Dim Master As Worksheet
Dim Slave As Worksheet 'the following declares both master and slave as worksheets
fpath = "location of master workbook"
Set owb = Application.Workbooks.Open(fpath) 'opens the file path
Set Master = ThisWorkbook.Worksheets("name of sheet in workbook your pasting from") 'declares this workbook and sheet as "master"
Set Slave = owb.Worksheets("name of sheet in master you are pasting to") 'declares the workbook and sheet you're copying to as "slave"
For j = 1 To 10000 '(the master sheet) 'goes through each row from 1 to 10000
For i = 1 To 10000 '(the slave sheet) 'again does the same and the slave sheet
If Trim(Master.Cells(j, 4).Value2) = vbNullString Then Exit For 'if the ID is blank it will exit and move on to the next row
If Master.Cells(j, 1).Value = Slave.Cells(i, 1).Value Then 'the 1 represents column A, if cell in column A matches the cell in column D in the masterwork book then it will..
Slave.Cells(i, 2).Value = Master.Cells(j, 2).Value
'the cell here represent column B as it's a 2, you can change and add as many as you like to bring through the column
End If
Next
Next
MsgBox ("Successful")