Vba 我需要从一个工作簿中的某些列提取数据，并将其附加到另一个工作簿中的现有数据
老实说，我搜索了又搜索，虽然可能有一个类似问题的现有答案，但我似乎找不到它。也就是说：Vba 我需要从一个工作簿中的某些列提取数据，并将其附加到另一个工作簿中的现有数据,vba,Vba,老实说，我搜索了又搜索，虽然可能有一个类似问题的现有答案，但我似乎找不到它。也就是说： 我在两个不同的工作簿中有数据，我需要从每周生成的文件中选择数量的非连续列复制数据，并将其附加到主文件中现有数据的特定列中 我每周都会收到一个名为results.data.xls的新文件，其中包含5列具有可变记录计数的数据—有些星期可能是两行，有些星期可能是200行+ 我希望能够复制results.data.xls中列“B”（'PRODUCT\u FORMAT\u CAPACITY'）、列“D”（'CUSTO
- 我在两个不同的工作簿中有数据，我需要从每周生成的文件中选择数量的非连续列复制数据，并将其附加到主文件中现有数据的特定列中
- 我每周都会收到一个名为results.data.xls的新文件，其中包含5列具有可变记录计数的数据—有些星期可能是两行，有些星期可能是200行+
- 我希望能够复制results.data.xls中列“B”（
）、列“D”（'PRODUCT\u FORMAT\u CAPACITY'
）和列“E”（'CUSTOMER'
）中出现的数据，并将其附加到master.data.xls中类似标题列中的现有数据中BILLTO\u CUSTOMER\u NUM - 录制宏并不能让我走得更远，因为我显然无法让它理解附加数据的必要性-我见过VBA命令可以实现这一点，但我不知道如何修改简单的录制以使其满足我的需要
- 我创建了工作簿“master.data.xls”，并在其中创建了工作表“Combined”。你没有提到你的工作表名称，所以我自己编了一份。我在三列标题“产品格式容量”、“客户”和“BILLTO客户数量”，但不是B、D和E列。我在这些列中放置了一些随机数据
- 我创建了工作簿“results.data.xls”，其中还有工作表“Week”。我将B、D和E列标题为“产品形式、容量”、“客户”和“账单数量”。我在这些列中放置了一些随机数据
- 我在单独的工作簿中创建了宏。我更喜欢将我的宏保存在单独的工作簿中，这样用户（1）就不会为它们烦恼，（2）就无法更改它们
' "Option Explicit" stops a mispelt name becoming a declaration. Without
' "Option Explicit" the following will define a new variable Conut. Such
' errors can be very difficult to find:
' Dim Count As Long
' Conut = Count + 1
Option Explicit
' Use constants for values that will not change during a run of the macro
' particularly if you have to use them several times or if purpose of the
' value is not obvious. "Cells(Row,2)" is a lot harder to understand than
' "Cells(Row,ColResultProduct)". I have used WBkMasterName several times.
' If the workbook is renamed, changing the constant declaration fixes the
' problem.
Const ColResultProduct As Long = 2
Const ColBillToName As String = "BILLTO_CUSTOMER_NUM"
Const ColCustomerName As String = "CUSTOMER"
Const ColProductName As String = "PRODUCT_FORMAT_CAPACITY"
Const WBkMasterName As String = "master.data.xls"
Const WBkResultName As String = "results.data.xls"
Const WShtMasterName As String = "Combined"
Const WShtResultName As String = "Week"
' My naming convention is ABC where A is the type (Col for column, WBk for
' workbook, etc), B identifies the particular A (for example, for Col, B
' identifies the worksheet) and C identifies which AB if there is more than
' one (for ColMaster I have ColMasterProduct, ColMasterBillTo, ColMasterCrnt
' (Crnt = Current), etc. You may not like my naming convention. Fine, pick
' your own or, better still, agree one with colleagues. Conventions mean
' you can look at the program you wrote twelve months ago or your colleague
' wrote and understand the variables.
' My comments tell you my objective or my reason for selecting method A and
' not B. They do not explain VBA syntax. For example, once you know the
' Workbooks.Open statement exists, it is easy to find an explanation of its
' syntax within the VBA help or via an internet search,
Sub Demo()
Dim ColMasterBillTo As Long
Dim ColMasterCrnt As Long
Dim ColMasterCustomer As Long
Dim ColMasterLast As Long
Dim ColMasterProduct As Long
Dim ColResultBillTo As Long
Dim ColResultCustomer As String
Dim CountMasterColFoundCrnt As Long
Dim CountMasterColFoundTotal As Long
Dim InxWBkCrnt As Long
Dim PathCrnt As String
Dim RngResult As Range
Dim RowMasterNext As Long
Dim RowResultLast As Long
Dim TempStg As String
Dim WBkMaster As Workbook
Dim WBkResult As Workbook
Dim WShtMaster As Worksheet
Dim WShtResult As Worksheet
' ThisWorkbook identifies the workbook containing the macro.
' I will assume the data workbooks are in the same folder as
' the macro workbook.
PathCrnt = ThisWorkbook.Path
' You do not want to run this macro when someone has the data workbooks open
' so check for them being within the collection of open workbooks.
For InxWBkCrnt = 1 To Workbooks.Count
If Workbooks(InxWBkCrnt).Name = WBkMasterName Then
Call MsgBox("Please close workbook '" & WBkMasterName & _
"' before running this macro.", vbOKOnly)
Exit Sub
End If
If Workbooks(InxWBkCrnt).Name = WBkResultName Then
Call MsgBox("Please close workbook '" & WBkResultName & _
"' before running this macro.", vbOKOnly)
Exit Sub
End If
Next
' The next blocks of code check that the workbooks exist and contain the
' expected worksheets with the expected columns. You may think that this
' code is unnecessary and I hope you are right. However, if something is
' wrong, do you want your macro to fail unexpectedly with a yellow statement
' and an error message a programmer may find difficult to understand or
' corrupt data because columns have moved or do you want the macro to close
' tidily with an error message that the user understands?
' "On Error Resume Next" Statement "On Error GoTo 0" switches off normal
' error processing for "Statement". You can then check if "Statement"
' has had the expected result. Some statements set Err.Number and
' Err.Description if they fail but Workbooks.Open does not.
' You can use Dir$() to check for the file existing but (1) I think the
' approach below is marginally easier and (2) Dir$() checks for existence
' not openability.
' Try to open data workbooks. Report failure to the user.
On Error Resume Next
Workbooks.Open PathCrnt & "\" & WBkMasterName
On Error GoTo 0
If ActiveWorkbook.Name = ThisWorkbook.Name Then
Call MsgBox("I was unable to open workbook " & _
WBkMasterName & "'.", vbOKOnly)
Exit Sub
End If
Set WBkMaster = ActiveWorkbook
On Error Resume Next
Workbooks.Open PathCrnt & "\" & WBkResultName
On Error GoTo 0
If ActiveWorkbook.Name = WBkMaster.Name Then
Call MsgBox("I was unable to open workbook '" & _
WBkResultName & "'.", vbOKOnly)
' Tidy up by closing open workbook and releasing resource
WBkMaster.Close SaveChanges:=False
Set WBkMaster = Nothing
Exit Sub
End If
Set WBkResult = ActiveWorkbook
' Try to reference worksheets
With WBkMaster
On Error Resume Next
Set WShtMaster = .Worksheets(WShtMasterName)
On Error GoTo 0
If WShtMaster Is Nothing Then
Call MsgBox("Workbook '" & WBkMasterName & "' does not contain " & _
"worksheet '" & WShtMasterName & "'.", vbOKOnly)
WBkMaster.Close SaveChanges:=False
WBkResult.Close SaveChanges:=False
Set WBkMaster = Nothing
Set WBkResult = Nothing
Exit Sub
End If
End With
With WBkResult
On Error Resume Next
Set WShtResult = .Worksheets(WShtResultName)
On Error GoTo 0
If WShtResult Is Nothing Then
Call MsgBox("Workbook '" & WBkResultName & "' does not contain " & _
"worksheet '" & WShtResultName & "'.", vbOKOnly)
WBkMaster.Close SaveChanges:=False
WBkResult.Close SaveChanges:=False
Set WBkMaster = Nothing
Set WBkResult = Nothing
Exit Sub
End If
End With
With WShtResult
' I have defined 'ColResultProduct' with a constant. That will be the best
' approach unless you know to expect a particular type of change.
' I use "Debug.Assert Boolean-expression" extensively during development.
' In particular, I place "Debug.Assert False" above every alternative path
' through my code. When I hit a "Debug.Assert False" during testing, I
' comment it out. If any remain at the end of testing I know that either
' my testing was not as thorough as it should be or I have allowed for
' a situation that does not exist. Either way, the code needs review.
' Leaving a "Debug.Assert" statement in code you release to users would be
' very unprofessional.
Debug.Assert .Cells(1, ColResultProduct).Value = ColProductName
' In a Cells object, the column can be a number or a letter. Use whichever
' you prefer. I do not like statements like this buried in the code. This
' should be a constant statement at the top of the module.
ColResultCustomer = "D"
If .Cells(1, ColResultCustomer).Value <> ColCustomerName Then
' Note the use of property Address as an easy way of converting a VBA
' style address to a user style address. Note also the use of Replace to
' remove the dollar signs from "$D$1" to give "D1"
Call MsgBox("Cell " & Replace(.Cells(1, ColResultCustomer).Address, "$", "") _
& " of worksheet '" & WShtResultName & "' of workbook '" & _
WBkResultName & "' is not " & ColCustomerName & ".", vbOKOnly)
WBkMaster.Close SaveChanges:=False
WBkResult.Close SaveChanges:=False
Set WBkMaster = Nothing
Set WBkResult = Nothing
Exit Sub
End If
ColResultBillTo = 5 ' Again, this should be a constant
If .Cells(1, ColResultBillTo).Value <> ColBillToName Then
Call MsgBox("Cell " & Replace(.Cells(1, ColResultBillTo).Address, "$", "") _
& " of worksheet '" & WShtResultName & "' of workbook '" & _
WBkResultName & "' is not " & ColBillToName & ".", vbOKOnly)
WBkMaster.Close SaveChanges:=False
WBkResult.Close SaveChanges:=False
Set WBkMaster = Nothing
Set WBkResult = Nothing
Exit Sub
End If
End With
With WShtMaster
' Do not consider anything like this code unless columns are moved
' regularly. It is so easy to waste time preparing for situations that will
' never occur. You could amend three constants many times more quickly than
' you can get code like this debugged. I have code like this because I
' have situations in which columns moving is likely to occur and I do
' not want my diverse users coming back to me when it does.
ColMasterLast = .Cells(1, Columns.Count).End(xlToLeft).Column
CountMasterColFoundTotal = 0
ColMasterBillTo = 0
ColMasterCustomer = 0
ColMasterProduct = 0
' Look for the three headers and record their columns. Record
' number of headers found.
For ColMasterCrnt = 1 To ColMasterLast
If .Cells(1, ColMasterCrnt).Value = ColBillToName Then
CountMasterColFoundTotal = CountMasterColFoundTotal + 1
ColMasterBillTo = ColMasterCrnt
ElseIf .Cells(1, ColMasterCrnt).Value = ColCustomerName Then
CountMasterColFoundTotal = CountMasterColFoundTotal + 1
ColMasterCustomer = ColMasterCrnt
ElseIf .Cells(1, ColMasterCrnt).Value = ColProductName Then
CountMasterColFoundTotal = CountMasterColFoundTotal + 1
ColMasterProduct = ColMasterCrnt
End If
Next
If CountMasterColFoundTotal <> 3 Then
' One or more column has not been found
CountMasterColFoundCrnt = 3
TempStg = "I cannot find column headings"
If ColMasterProduct = 0 Then
'Debug.Assert False
TempStg = TempStg & " " & ColProductName
CountMasterColFoundCrnt = CountMasterColFoundCrnt - 1
If CountMasterColFoundCrnt - 1 >= CountMasterColFoundTotal Then
'Debug.Assert False
TempStg = TempStg & " or"
'Else
'Debug.Assert False
End If
'Else
'Debug.Assert False
End If
If ColMasterCustomer = 0 Then
'Debug.Assert False
TempStg = TempStg & " " & ColCustomerName
CountMasterColFoundCrnt = CountMasterColFoundCrnt - 1
If CountMasterColFoundCrnt - 1 >= CountMasterColFoundTotal Then
'Debug.Assert False
TempStg = TempStg & " or"
'Else
Debug.Assert False
End If
'Else
'Debug.Assert False
End If
If ColMasterBillTo = 0 Then
'Debug.Assert False
TempStg = TempStg & " " & ColBillToName
'Else
'Debug.Assert False
End If
TempStg = TempStg & " in row 1 of worksheet '" & _
WShtMasterName & "' of workbook '" & WBkMasterName & "'."
Call MsgBox(TempStg, vbOKOnly)
WBkMaster.Close SaveChanges:=False
WBkResult.Close SaveChanges:=False
Set WBkMaster = Nothing
Set WBkResult = Nothing
Exit Sub
End If
End With
' If get here then both workbooks are as required.
' Find last row of results worksheet and next row of master worksheet
' Copy product column from results to master
With WShtResult
RowResultLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
Set RngResult = .Range(.Cells(2, ColResultProduct), _
.Cells(RowResultLast, ColResultProduct))
End With
With WShtMaster
RowMasterNext = .UsedRange.Row + .UsedRange.Rows.Count
RngResult.Copy Destination:=.Cells(RowMasterNext, ColMasterProduct)
End With
' Copy customer column from results to master
With WShtResult
Set RngResult = .Range(.Cells(2, ColResultCustomer), _
.Cells(RowResultLast, ColResultCustomer))
End With
With WShtMaster
RngResult.Copy Destination:=.Cells(RowMasterNext, ColMasterCustomer)
End With
' Copy bill to column from results to master
With WShtResult
Set RngResult = .Range(.Cells(2, ColResultBillTo), _
.Cells(RowResultLast, ColResultBillTo))
End With
With WShtMaster
RngResult.Copy Destination:=.Cells(RowMasterNext, ColMasterBillTo)
End With
WBkMaster.Close SaveChanges:=True
WBkResult.Close SaveChanges:=False
End Sub
““Option Explicit”阻止错误的名称变成声明。没有
““Option Explicit”下面将定义一个新变量Conut。这样的
“错误可能很难找到：
”“我想我会的
'Conut=计数+1
选项显式
'对在宏运行期间不会更改的值使用常量
尤其是当你不得不多次使用它们，或者
“价值不明显。“单元格（第2行）”比
““单元格（行，ColResultProduct）”。我已经使用WBkMasterName好几次了。
'如果重命名工作簿，更改常量声明将修复
“问题。
Const ColResultProduct的长度=2
Const ColBillToName As String=“BILLTO\u CUSTOMER\u NUM”
Const ColCustomerName As String=“CUSTOMER”
Const ColProductName As String=“产品\u格式\u容量”
Const WBkMasterName As String=“master.data.xls”
Const WBkResultName As String=“results.data.xls”
Const WShtMasterName As String=“Combined”
Const WShtResultName As String=“Week”
'我的命名约定是ABC，其中A是类型（列为Col，列为WBk
'工作簿等），B标识特定的A（例如，对于Col，B
'标识工作表）和C标识哪个AB（如果超过
“一（对于ColMaster，我有ColMasterProduct、ColMasterBillTo、ColMasterCrnt
’（Crnt=Current）等。您可能不喜欢我的命名约定。好的，选择
你自己的，或者更好的是，与同事们达成一致。惯例意味着
你可以看看你12个月前写的程序或者你的同事
'编写并理解变量。
“我的评论告诉你我选择方法A的目的或原因，以及
'不是B。它们不会解释VBA语法。例如，一旦您知道
'工作簿。如果存在Open语句，则很容易找到它的解释
'VBA帮助中的语法或通过internet搜索，
副演示（）
暗淡的科尔马斯特比尔托一样长
暗淡的冷色调和长的一样
暗淡的阴霾和你的顾客一样长
暗淡的秋千能持续多久
暗淡的Colmaster产品如长
暗淡的寒冷天气会使你的身体变长
Dim ColResultCustomer作为字符串
Dim CountMasterColFoundCrnt尽可能长
Dim CountMasterColFoundTotal尽可能长
变暗InxWBkCrnt与长
Dim PathCrnt作为字符串
Dim RngResult As范围
暗淡的光线下一个一样长
昏暗的RowResultLast尽可能长
作为字符串的暗TempStg
将WBkMaster设置为工作簿
将WBkResult设置为工作簿
将WShtMaster设置为工作表
将WShtResult设置为工作表
'此工作簿标识包含宏的工作簿。
'我将假定数据工作簿与
'宏工作簿。
PathCrnt=此工作簿。路径
'当有人打开数据工作簿时，您不希望运行此宏
因此，检查它们是否在打开的工作簿集合中。
对于InxWBkCrnt=1的工作簿。计数
如果工作簿（InxWBkCrnt）.Name=WBkMasterName，则
调用MsgBox（“请关闭工作簿”&WBkMasterName&_
“'在运行此宏之前”“，vbOKOnly）
出口接头
如果结束
如果工作簿（InxWBkCrnt）.Name=WBkResultName，则
调用MsgBox（“请关闭工作簿”&WBkResultName&_
“‘之前