用于处理大量数据的excel的VBA中的宏

Question

我需要一些关于我正在处理的特定宏的帮助。 宏处理已从pdf文件导入的数据列。导入过程会生成多张一致的数据，所有变量都保留在多张工作表的相同列中。该宏需要读取三列数字，将两列中的所有单元格从另一列中减去，将解算值置于每行末尾的空列中。然后重复两列的另一个组合。之后，它需要将解决的值与边距值进行比较，并生成一张新表格，该表格将失败的边距值所在的整行数据拖入工作簿前面的新工作表中。

这是我到目前为止。 到目前为止，我可以在一张纸上预制此功能，但不知道如何将此功能自动转换为其他纸张。数字填充列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 

我使用数组，因为它们对使用Excel-公式处理数据时都远远更有效地解决问题。虽然这不太可能在〜200行的项目中提高性能，但当处理数千行甚至更多时，它会产生巨大的差异。

我也使用常量作为列位置，以便于您在未来调整这些参数。尽管如此，即使是常数（为此目的）也是一种可怕的习惯，所以不习惯它们。了解如何计算数据的位置。

最后，请（对于所有程序化的爱）不要复制和粘贴此代码，并且永不回头。我把它放在这里供你（和其他人）从中学习。不是因为它是一种快速修复。我希望你能用它来增长。