我试图通过将一个选项卡中的单位和美元乘以另一个选项卡上的％附着率，将两个电子表格中的数据合并到一个结果表中。看来公式在“范围”中出现错误，但是我不是程序员，因此无法使用MS Excel在线文献和我所看到的Stack Overflow帖子对此进行解析（看起来与{ {3}}）。
最初编写代码的个人无法提供帮助。非常感谢您的指导！
以下代码错误：
Dim bContinue As Boolean
bContinue = Range("Calc.Inputs.Exists").Value 'only continue if the ID returns a valid record. _
When the macro reaches beyond the last record, this will turn false and the macro will terminate.
下面的完整脚本...
Sub Splits_Generator()
'Check if user wants to continue
Dim vResponse As Variant
vResponse = MsgBox("This will take a 2-5 minutes to complete. " & _
"The Excel screen will appear unresponsive during this time. Do you wish to continue?", vbOKCancel + vbQuestion)
If vResponse = vbCancel Then
MsgBox "Action Canceled!", vbCritical
Exit Sub
End If
'Set application settings and timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim t1 As Date
t1 = Timer
'Initialize a few variables
Dim OutputsHeaders() As Variant
OutputsHeaders = Range("Outputs[#Headers]").Value 'Loads Outputs headers into an array.
Dim dictColNum As Object
Set dictColNum = CreateObject("scripting.dictionary")
'Creating dictionary object to keep track of the column numbers where the Outputs header _
items are located on the Calc page
Dim dictFormula As Object
Set dictFormula = CreateObject("scripting.dictionary")
'Creating dictionary object. Contains the formula used to calculate the column if the _
column's values are calculated on the Outputs page.
'Find the column numbers for each header item
Dim x As Long
For x = 1 To UBound(OutputsHeaders, 2)
On Error Resume Next
dictColNum.Item(OutputsHeaders(1, x)) = _
Application.WorksheetFunction.Match(OutputsHeaders(1, x), Range("Calc.Header"), 0)
'Lookup the column number
If Err <> 0 Then
'If no number was found, this means there is a column on the Outputs page that is _
not found on the Calc page
dictColNum.Item(OutputsHeaders(1, x)) = Empty
'In this case, we have no column number so it is set to empty
If Mid(Range("Outputs[#Headers]").Cells(2, x).Formula, 1, 1) = "=" Then
'Check if the values in this Outputs column are calculated on the Outputs page _
(usually every thing should be calculated on the Calc page so this is just _
preparing for the possibility that a calculation could have been _
done on the Outputs page itself). Otherwise the calculation would be _
overwritten and the formula lost.
dictFormula.Item(OutputsHeaders(1, x)) = Range("Outputs[#Headers]").Cells(2, x).FormulaR1C1
'The formula in the first row of data will be used for the whole column. _
This assumes the same calculation is used on the whole column, which should _
be a fair assumption since we are using defined tables
Else
dictFormula.Item(OutputsHeaders(1, x)) = Empty 'If not a formula and not found on the Calc page, then the data will be overwritten
End If
End If
On Error GoTo 0
Next
'Delete old data
Application.GoTo "Outputs"
Range("Outputs").AutoFilter
'Turns off AutoFilter. If left on and data is filtered, then the macro will produce incorrect _
results
Range("Outputs[#Data]").ClearContents
'Initialize more variables
Dim InitialRecordCounter As Long
InitialRecordCounter = Range("Calc.ID").Value
'Remember which IDs were set before the macro started
Dim InitialSplitsID As Variant
InitialSplitsID = Range("Calc.Splits.ID").Formula
'Remember which IDs were set before the macro started
Dim RecordCounter As Long 'Count of records processed from the "Inputs" sheet
RecordCounter = 1
Range("Calc.ID") = RecordCounter 'Calc starts with record one
Range("Calc.ID").Worksheet.Calculate 'Force sheet to recalculate
Dim ArrayCounter As Long 'Count of records currently loaded into the array
ArrayCounter = 0
Dim OutputsRecordCounter As Long 'Total number of records added to the "Outputs" sheet
OutputsRecordCounter = 0
Dim LastOutputsRecordLoaded As Long
'The number of records in the "Outputs" sheet when data was last loaded into it
LastOutputsRecordLoaded = 0
Dim Outputs() As Variant
ReDim Outputs(1 To UBound(OutputsHeaders, 2), 1 To 1)
'This array has the same number of rows as the number of columns in the Outputs Header.
'Data must be flipped on its side to allow the array to add more records. _
New records can only be added on the 2nd dimension.
Dim bContinue As Boolean
bContinue = Range("Calc.Inputs.Exists").Value 'only continue if the ID returns a valid record. _
When the macro reaches beyond the last record, this will turn false and the macro will terminate.
Dim bFirstInvalid As Boolean 'True until at least one invalid record has been found
bFirstInvalid = True
Dim InvalidRow As Long
Dim InvalidSheetCount As Long
InvalidSheetCount = 1
Dim sInvalidSheetName As String
sInvalidSheetName = "Invalid Records"
Dim wsInvalid As Worksheet
Do While bContinue
Dim SplitsCounter As Long 'Count of number of Splits per Input record
Range("Calc.Splits.ID").Value = 1 & " " _
& Range("Calc.Type").Value 'Update the Splits ID to the next Splits record
Range("Calc.Splits.ID").Worksheet.Calculate 'Force sheet to recalculate
For SplitsCounter = 1 To Range("Calc.SplitsCount").Value 'Represents the number of rows that each Inputs row will be split into
Range("Calc.Splits.ID").Value = SplitsCounter & " " _
& Range("Calc.Type").Value 'Update the Splits ID to the next Splits record
Range("Calc.Splits.ID").Worksheet.Calculate 'Force sheet to recalculate
If Range("Calc.ValidRecord").Value Then
'If the record is not valid, it will skip processing it. For example, the user _
can set a condition that the total volume or revenue has to be above a certain _
threshold. If not, then it will not make it to the Outputs page. The purpose _
of this condition is to eliminate rows from the Output page that do not provide _
meaningful or accurate information. It reduces processing time and lowers file size.
If Range("Calc.Splits.Exists").Value Then
ArrayCounter = ArrayCounter + 1
OutputsRecordCounter = OutputsRecordCounter + 1
ReDim Preserve Outputs(1 To UBound(Outputs, 1), 1 To ArrayCounter)
'Expand the array to allow values to be inserted for this record
For x = 1 To UBound(Outputs, 1)
If dictColNum.Item(OutputsHeaders(1, x)) <> Empty Then
'If the column number is not an empty value, then the Calc page has a _
calculated value we can use
Outputs(x, ArrayCounter) = _
Range("Calc.Output").Cells(1, dictColNum.Item(OutputsHeaders(1, x))).Value
'Set the value of this element of the array
Else
'If the column number is an empty value that means there is not a column _
with a matching name in the Calc page
If dictFormula.Item(OutputsHeaders(1, x)) = Empty Then
'We're checking whether this column has a formula we should use from _
the Outputs page
Outputs(x, ArrayCounter) = Empty
'If not, then we set the field value to empty
Else
Outputs(x, ArrayCounter) = dictFormula.Item(OutputsHeaders(1, x))
'If so, then we use the formula we found earlier in the code
End If
End If
Next
If OutputsRecordCounter Mod 2000 = 0 Then
'Reports the current record to the user as the macro is running. _
It is pre-set to report at increments of 2000. This is somewhat arbitrary. _
However, I did find that if you set the number too low, i.e., reporting _
very frequently, then the macro performance deterioriates.
Application.StatusBar = "Current Record: " & OutputsRecordCounter
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
If ArrayCounter Mod 10000 = 0 Then
'I found that processing the data in blocks of 10k records keeps memory _
from getting clogged and results in a 2x performance increase in the macro
Outputs = MyTranspose(Outputs)
'As mentioned earlier, the data had to be loaded into a transposed array. _
Now we transpose it back.
Range(Range("Outputs[#Headers]").Offset(LastOutputsRecordLoaded + 1, 0), _
Range("Outputs[#Headers]").Offset(LastOutputsRecordLoaded + ArrayCounter, 0)).FormulaR1C1 _
= Outputs
'Load the data onto the Outputs page
LastOutputsRecordLoaded = OutputsRecordCounter
ArrayCounter = 0
ReDim Outputs(1 To UBound(OutputsHeaders, 2), 1 To 1)
'This array has the same number of rows as the number of columns in the _
Outputs Header. Data must be flipped on its side to allow the array to _
add more records. New records can only be added on the 2nd dimension.
End If
Else
If bFirstInvalid Then
'If we have not already had at least one invalid record, then we will need to prep _
the sheet for the first use
bFirstInvalid = False
Set wsInvalid = Worksheets.Add
Do
Err = 0
On Error Resume Next
If InvalidSheetCount = 1 Then
wsInvalid.Name = sInvalidSheetName
Else
wsInvalid.Name = sInvalidSheetName & " (" & InvalidSheetCount & ")"
End If
InvalidSheetCount = InvalidSheetCount + 1
Loop Until Err = 0
On Error GoTo 0
wsInvalid.Range("A1") = "Inputs ID"
wsInvalid.Range("B1") = "Splits ID"
InvalidRow = 2
End If
wsInvalid.Cells(InvalidRow, 1) = Range("Calc.ID")
wsInvalid.Cells(InvalidRow, 2) = Range("Calc.Splits.ID")
InvalidRow = InvalidRow + 1
End If
Else
If bFirstInvalid Then
'If we have not already had at least one invalid record, then we will need to prep _
the sheet for the first use
bFirstInvalid = False
Set wsInvalid = Worksheets.Add
Do
Err = 0
On Error Resume Next
If InvalidSheetCount = 1 Then
wsInvalid.Name = sInvalidSheetName
Else
wsInvalid.Name = sInvalidSheetName & " (" & InvalidSheetCount & ")"
End If
InvalidSheetCount = InvalidSheetCount + 1
Loop Until Err = 0
On Error GoTo 0
wsInvalid.Range("A1") = "Inputs ID"
wsInvalid.Range("B1") = "Splits ID"
InvalidRow = 2
wsInvalid.Cells(1, 1).AutoFilter
'Turn on autofilter on invalids sheet
End If
wsInvalid.Cells(InvalidRow, 1) = Range("Calc.ID")
wsInvalid.Cells(InvalidRow, 2) = "All"
InvalidRow = InvalidRow + 1
Exit For
End If
Next
RecordCounter = RecordCounter + 1
Range("Calc.ID") = RecordCounter 'Update the ID to the next record
Range("Calc.ID").Worksheet.Calculate 'Force sheet to recalculate
bContinue = Range("Calc.Inputs.Exists").Value 'only continue if the ID returns a value record
Loop
If ArrayCounter > 0 Then
'If there are any data not loaded into the Outputs page (under the 10k threshold), _
then take care of the remainder.
Outputs = MyTranspose(Outputs)
'As mentioned earlier, the data had to be loaded into a transposed array. _
Now we transpose it back.
Range(Range("Outputs[#Headers]").Offset(LastOutputsRecordLoaded + 1, 0), _
Range("Outputs[#Headers]").Offset(LastOutputsRecordLoaded + ArrayCounter, 0)).FormulaR1C1 = Outputs
'Load the data onto the Outputs page
End If
'End of macro code
Range("Outputs").Worksheet.ListObjects("Outputs").Resize Range("Outputs").CurrentRegion
'Reset the size of the Outputs range to align to the size of the data added. _
This can come into play if the previous set of data had been larger. There will be _
blank rows in the table in this case.
Range("Outputs").AutoFilter
'Put the autofilter back on
Range("Calc.ID") = InitialRecordCounter
'Reset the yellow highlighted values on the Calc page to their pre-macro values
Range("Calc.Splits.ID").Value = InitialSplitsID
'Reset the yellow highlighted values on the Calc page to their pre-macro values
ThisWorkbook.RefreshAll
'Refresh all pivot tables
Set dictColNum = Nothing 'Set objects to nothing. Helps keep memory clean
Set dictFormula = Nothing 'Set objects to nothing. Helps keep memory clean
Set wsInvalid = Nothing 'Set objects to nothing. Helps keep memory clean
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
Dim t2 As Date
t2 = Timer - t1
MsgBox "Done. This took " & IIf(t2 > 60, Format(Int(t2 / 60), "0") & " min ", "") & Format(t2 Mod 60, "0") & " seconds to complete."
End Sub