大量のデータを処理するExcel for VBAのマクロ

Question

私が取り組んでいる特定のマクロについて助けが必要です。 マクロは、pdfファイルからインポートされたデータの列を処理します。インポートプロセスでは、一貫したデータの複数のシートが作成され、すべての変数は複数のシートにわたって同じ列にとどまります。このマクロは、3つの列の数値を読み込み、2つの列のすべてのセルを1つずつ減算し、解決された値を各行の最後にある空の列に配置する必要があります。次に、2つの列の別の組み合わせを使用して繰り返します。その後、解決された値をマージン値と比較し、失敗したマージン値が入っているデータ行全体をブックの前の新しいシートにプルする新しいシートを生成する必要があります。

これはこれまで私が行ってきたことです。 これまでのところ1枚のシートに機能をプリフォームできますが、これを他のシートに自動化する方法はわかりません。数字は列B、C、およびDを入力します。答えはG、H、およびHが空の後の他の列に配置する必要があります。

Private Sub FindAndCreateSheet3dBm() 
    ' Declare variables 
    Dim eWs As Worksheet 
    Dim rMargin As Range 
    Dim myUnion As Range    

     'Column G: subrtact max and measured values 
     Worksheets("page 6").Range("G1:G21").Formula = "=(C1-D1)" 
      '*need to fix sheet reference, make all sheets, add flexible range to 
      'end of G range 

     'Column H: subrtact measured and min values 
     Worksheets("page 6").Range("H1:H21").Formula = "=(D1-B1)" 
      '*need to fix sheet reference, make all sheets, add flexible range to 
      'end of H range  

     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     ' Create the report sheet at first position then name it "Less than 3dBm" 
     Dim wsReport As Worksheet 
     Dim rCellwsReport As Range 
     Set wsReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1)) 
     wsReport.Name = "Less than 3dBm" 

     Set rCellwsReport = wsReport.Cells(1, 1) 

     'Create union of columns to search G and H? 
     Set myUnion = Union(Columns("G"), Columns("H")) 

     'Check whole Workbook, union G and H for values less than rMargin 

    NextSheet: 
     Next 
    End Sub 

これは、ニーズのために働く必要があり、あなたに

Answer 1

ありがとうございます。私のコードに入る前に、私はちょうどあなたがコミュニティから得るレスポンスは、「私はこれをどうやってやるのですか？」という質問に、SOは私のサイトのコードではないということに注意したいと思います。壊れたコードを修正するのはうれしいですが、この種の問題は一般的にGoogleで解決できます。

それは私が取り組んでいたプロジェクトからの休憩を望んでいたので、私は一緒に投げました。ここでの希望は、より良いコードを書く方法の学習機会として使うことができるということです（そしておそらくプロセスの上司からいくつかの名声を得ることができます）。

Private Sub FindAndCreateSheet3dBm() 
    ' Ideally, you wouldnt even use something like this. For your purposes 
    ' it will get you going. I highly recommend finding a dynamic way of 
    ' determining the positions of the data. It may be consistent now, but 
    ' in the world of programming, everything changes, especially when 
    ' you think it wont. 

    Const FIRST_INPUT_COL As Long = 3  ' Column C 
    Const SECOND_INPUT_COL As Long = 4  '   D 
    Const THIRD_INPUT_COL As Long = 2  '   B 

    Const FIRST_OUTPUT_COL As Long = 7  '   G 
    Const SECOND_OUTPUT_COL As Long = 8  '   H 

    Dim marginReport As Worksheet 
    Set marginReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1)) 
    marginReport.Name = "Less than 3dBm" 

    Dim targetWorksheet As Worksheet 

    For Each targetWorksheet In ThisWorkbook.Worksheets 
     If Not targetWorksheet Is marginReport Then 
      Dim inputData As Variant 
      inputData = targetWorksheet.UsedRange.value 

      Dim outputData As Variant 
      ' I resize the array to be the exact same as the first, but to add two additional columns 
      ReDim outputData(LBound(inputData, 1) To UBound(inputData, 1), LBound(inputData, 2) To UBound(inputData, 2) + 2) 

      Dim i As Long 
      Dim j As Long 
      ' Loop through rows 
      For i = LBound(inputData, 1) To UBound(inputData, 1) 
       ' Loop through columns 
       For j = LBound(inputData, 2) To UBound(inputData, 2) 
        ' Essentially, just copy the data 
        outputData(i, j) = inputData(i, j) 
       Next 
      Next 

      Dim offSetValue As Long 
      If LBound(outputData, 2) = 1 Then offSetValue = -1 
      ' For your purposes I will use hardcoded indices here, but it is far more ideal to manage this in a more flexible manner 
      For i = LBound(outputData, 1) To UBound(outputData, 1) 
       outputData(i, FIRST_OUTPUT_COL) = outputData(i, FIRST_INPUT_COL) - outputData(i, SECOND_INPUT_COL) 
       outputData(i, SECOND_OUTPUT_COL) = outputData(i, FIRST_OUTPUT_COL) - outputData(i, THIRD_INPUT_COL) 
       If LessThanMargin(outputData(i, SECOND_OUTPUT_COL)) Then 
        For j = LBound(outputData, 2) To UBound(outputData, 2) 
         ' I start with the output worksheet, and use the 'End(xlUp) to find the first 
         ' non-blank row. I then iterate columnwise and add values to the row beneath it. 
         ' The offSetValue variable ensures I am not skipping any cells if the array 
         ' is 1-Based versus the default 0-Base. 
         marginReport.Range("A1048576").End(xlUp).Offset(1, j + offSetValue).value = outputData(i, j) 
        Next 
       End If 
      Next 

      OutputArray outputData, targetWorksheet, "UpdatedData_" & UCase(Replace(targetWorksheet.Name, " ", "_")) 
     End If 
    Next 
End Sub 
' I am just checking for a negative number here, but change this to use the logic you need 
Public Function LessThanMargin(ByVal InputValue As Double) 
    LessThanMargin = InputValue < 0 
End Function 
Public Sub OutputArray(ByVal InputArray As Variant, ByVal InputWorksheet As Worksheet, ByVal TableName As String) 

    Dim AddLengthH As Long 
    Dim AddLengthW As Long 

    If NumberOfArrayDimensions(InputArray) = 2 Then 
     If LBound(InputArray, 1) = 0 Then AddLengthH = 1 
     If LBound(InputArray, 2) = 0 Then AddLengthW = 1 

     Dim r As Range 
     If Not InputWorksheet Is Nothing Then 
      With InputWorksheet 
       .Cells.Clear 
       Set r = .Range("A1").Resize(UBound(InputArray, 1) + AddLengthH, UBound(InputArray, 2) + AddLengthW) 
       r.value = InputArray 
       .ListObjects.Add(xlSrcRange, r, , xlYes).Name = TableName 

       With .ListObjects(1).Sort 
        .Header = xlYes 
        .MatchCase = False 
        .Orientation = xlTopToBottom 
        .SortMethod = xlPinYin 
        .Apply 
       End With 
      End With 
     End If 
    End If 
End Sub 

が、私はエクセルの数式を使用して対データを処理するとき、彼らははるかに効率的であるため、問題を解決するために配列を使用：

は、ここでは、コードです。 〜200行のプロジェクトではパフォーマンスが向上する可能性はほとんどありませんが、数千行以上を扱う場合には大きな違いがあります。

私はまた、将来、これらを調整しやすくするために、列の位置に定数を使用しました。しかし、これには注意が払われていますが、定数（この目的のため）でさえ恐ろしい習慣なので、慣れてはいけません。データの場所を計算する方法を学びます。

最後に、このコードをコピーして貼り付けたり、振り返ったりしないでください。私はあなた（そして他の人たち）がそれを学ぶためにここに置いています。それが何らかの迅速な修正ではないからです。私はあなたが成長するためにそれを使用できることを願っている。