2013-02-28 27 views
0

诚实,我已经搜索和搜索,虽然可能有一个类似问题的现有答案,我似乎无法找到它。这就是说:我需要从一个工作簿中的某些列提取数据并将其附加到另一个工作簿中的现有数据

  • 我有两个不同的工作簿中的数据,我需要将数据从一个选择一些非连续的列在一个文件时,它在主副本每周生成并追加到现有数据中的特定列文件

  • 我收到一个新的文件中的每个results.data.xls星期命名,它包含具有可变记录计数数据的5列 - 几个星期,也可能是两行,别人也可能是200+

  • 我希望能够复制出现在列“B”('PRODUCT_FORMAT_CAPACITY'),列“在results.data.xls d”('CUSTOMER')和列‘E’(BILLTO_CUSTOMER_NUM),并将它添加到现有的数据中的类似名称的列master.data.xls

  • 录制宏没有得到我很远因为我显然无法理解需要追加数据 - 我已经看到VBA命令可以启用这个功能,但我无法弄清楚如何修改简单的记录来让它做我想做的事情

回答

0

宏记录器非常适合用于发现复杂的单语句键盘命令的语法。但是如果你做A然后B然后C,记录器记录它们作为三个完全独立的命令,即使它们是单个命令的阶段。

要测试代码如下:

  • 我创建工作簿 'master.data.xls',并在其中,工作表 '组合拳'。你没有提到你的工作表名字,所以我已经自己编写了。我领导了三列'PRODUCT_FORMAT_CAPACITY','CUSTOMER'和'BILLTO_CUSTOMER_NUM',但没有列B,D和E.我在这些列中放置了一些随机数据。
  • 我创建了工作簿'results.data.xls',并在其中工作表'Week'。我领导了B,D和E'PRODUCT_FORMAT_CAPACITY','CUSTOMER'和'BILLTO_CUSTOMER_NUM'列。我在这些列中放置了一些随机数据。
  • 我在单独的工作簿中创建了宏。我更喜欢将宏放在单独的工作簿中,以便用户(1)不会对它们感到困扰,并且(2)不能更改它们。

你不会说如果你是新手编程或新的VBA。我假定你是编程新手。下面的大部分代码都是关于检查你的假设,如果事情不像预期那样优雅地失败。

有几种可供选择的技术可用于查找底行或最右列,但在任何情况下都无法工作。我为以下代码挑选了其中一种技术。看到我的这个答案的一些替代品的演示:https://stackoverflow.com/a/18220846/973283

希望这会有所帮助。

' "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 
相关问题