我需要一些我正在处理的特定宏的帮助。 宏处理从pdf文件导入的数据列。导入过程会生成多张一致数据，所有变量都保留在多个工作表的相同列中。此宏需要读取三列数字，将两列中的所有单元格相互减去，将求解的值放在每行末尾的空列中。然后用另外两列的组合重复。之后，它需要将求解的值与边距值进行比较，并生成一个新工作表，将失败的边距值所在的整行数据拉到工作簿前面的新工作表中。
这是我到目前为止所拥有的。 到目前为止，我可以在一张纸上预制该功能，但不知道如何将其自动化到其他纸张上。数字填充B，C和D列，在H为空后，答案应放在G，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
谢谢
答案 0 :(得分：0)
这应该可以满足您的需求。在我开始使用我的代码之前，我只想注意一下，当您询问我如何做到这一点时，您将从社区获得的回复通常是什么？＆＃39;问题是，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行项目中提升性能，但当你处理几千行甚至更多行时，它会产生巨大的差异。
我还使用常量作为列位置，以便您将来更容易调整这些位置。这有点谨慎，即使是常量（为此目的）也是一种可怕的习惯，所以不习惯它们。了解如何计算数据的位置。
最后，请（为了所有程序化的爱）不要复制并粘贴此代码，永远不要回头。我把它放在这里给你（和其他人）从中学习。不是它是某种快速解决方案。我希望你能用它来成长。