0

正直なところ、私は検索して検索しましたが、同様の質問に対する既存の回答があるかもしれませんが、見つけられないようです. それは言った:

  • 2 つの異なるワークブックにデータがあり、毎週生成されるファイル内の選択した数の連続していない列からデータをコピーし、マスター ファイル内の既存のデータの特定の列に追加する必要があります。

  • results.data.xls という名前の新しいファイルを毎週受け取ります。このファイルには、可変レコード数の 5 列のデータが含まれています。2 行になる週もあれば、200 行以上になる週もあります。

  • 'PRODUCT_FORMAT_CAPACITY'results.data.xls の列 "B" ( )、列 "D" ( 'CUSTOMER')、列 "E" ( ) に表示されるデータをコピーしBILLTO_CUSTOMER_NUM、マスターの同様のタイトルの列の既存のデータに追加できるようにしたい.data.xls

  • マクロを記録しても、データを追加する必要性を明確に理解できないため、あまり役に立ちません-これを有効にするVBAコマンドを見てきましたが、単純な記録を次のように変更する方法がわかりません必要なことをしてもらう

4

1 に答える 1

0

マクロ レコーダーは、複雑な単一ステートメントのキーボード コマンドの構文を検出するのに最適です。ただし、A、B、C の順に実行すると、レコーダーはこれらが 1 つのコマンドのフェーズであっても、これらを 3 つの完全に独立したコマンドとして記録します。

以下のコードをテストするには:

  • ワークブック 'master.data.xls' を作成し、その中にワークシート 'Combined' を作成しました。ワークシート名について言及していないので、自分で作成しました。'PRODUCT_FORMAT_CAPACITY'、'CUSTOMER'、'BILLTO_CUSTOMER_NUM' の 3 つの列に見出しを付けましたが、列 B、D、E には見出しを付けませんでした。これらの列にランダムなデータを配置しました。
  • ワークブック「results.data.xls」を作成し、その中にワークシート「Week」を作成しました。列 B、D、E の見出しを「PRODUCT_FORMAT_CAPACITY」、「CUSTOMER」、「BILLTO_CUSTOMER_NUM」にしました。これらの列にランダムなデータを配置しました。
  • 別のブックにマクロを作成しました。ユーザーが (1) マクロに煩わされず、(2) マクロを変更できないように、マクロを別々のワークブックに保持することを好みます。

プログラミングが初めてなのか、VBA が初めてなのかはわかりません。私はあなたがプログラミングの初心者だと仮定しました。以下のコードのほとんどは、仮定をチェックし、期待どおりでない場合は正常に失敗することに関するものです。

一番下の行または一番右の列を見つけるための代替手法がいくつかありますが、すべての状況で機能するものはありません。以下のコードでは、これらの手法の 1 つを選びました。いくつかの代替案のデモについては、私のこの回答を参照してください: 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
于 2013-09-06T19:28:56.373 に答える