我编写了一个宏，它从一个电子表格中获取订单行，对其进行小计，然后将订单总计转移到主跟踪器中。然后，主跟踪器中的列和字段需要手动更新。
我被告知宏将不再仅使用订单行引用电子表格，但需要从前一天（最新）版本的跟踪器引用跟踪器并匹配订单行那个。手动更新的单元格需要与它们引用的顺序保持一致。
我面临的问题是电子表格的合并。带有订单行的电子表格将包含主跟踪器上已有的订单以及一些新订单。我根据订单号对订单行进行排序，订单号是字母和数字的组合。因此，我不能只锁定单元格并将新订单添加到底部（新的演示订单将在先前现有的服务订单上方进行排序，按下服务订单并丢弃锁定的任何数据细胞）。
是否有办法维护跟踪器每一行的数据，同时仍然插入并向主跟踪器添加新的订单详细信息？
这是宏的原样（没有提到手动输入字段）：
Sub Subtotal()
'
' Subtotal Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
' Macro can handle 7500 order lines
' 1000 orders
'
' Must update File Name and File Location should anything change
'
Range("A1:X7500").Select
Range("M7").Activate
Selection.Copy
Sheets.Add After:=Sheets(Sheets.count)
ActiveSheet.Paste
ActiveSheet.Select
ActiveSheet.Name = "Tracker"
ActiveWorkbook.Worksheets("Tracker").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tracker").Sort.SortFields.Add Key:=Range( _
"B2:B5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tracker").Sort
.SetRange Range("A1:X7500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(20), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Dim saved As String
Dim start As Integer
Dim count As Integer
start = 2
saved = Cells(start, 2).Value
Dim i As Integer
For i = (start + 1) To 7500
Dim c As String
c = Range(Cells(i, 2), Cells(i, 2)).Value
If IsEmpty(c) Then
Exit For
End If
If Not saved = c Then
Dim tmp As Range
Set tmp = Range(Cells(start, 5), Cells(i - 1, 5))
Dim desc As Range
Set desc = Range(Cells(start, 7), Cells(i - 1, 7))
Dim line As Range
Set line = Range(Cells(start, 6), Cells(i - 1, 6))
count = 0
If Not tmp.Find("3000") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "3000"
count = count + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not tmp.Find("4000") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "4000"
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
count = count + 1
End If
If Not tmp.Find("5000 CASE") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "5000 Case"
count = count + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not tmp.Find("5000 STAIN") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "5000 Stain"
count = count + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not tmp.Find("SPECIALTY") Is Nothing Then
Dim count2 As Integer
count2 = 0
If Not line.Find("3000") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "3000"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("3500FC") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "3000"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("3700") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "3000"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("ECP") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "5000 Stain"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("3700C") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "5000 Stain"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("AS-") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "3000"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("CUSTOM CART") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "4000 Carts"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("ET-4000") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "4000 Carts"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("3700VV") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "4000 Carts"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If Not line.Find("4700SC") Is Nothing Then
Range(Cells(i, 3), Cells(i, 3)).Value = "4000 Carts"
count2 = count2 + 1
If Not desc.Find("Custom") Is Nothing Then
Range(Cells(i, 6), Cells(i, 6)).Value = "Custom"
Else: Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If count2 > 1 Then
Range(Cells(i, 3), Cells(i, 3)).Value = "Mixed"
End If
count = count + 1
End If
If Not tmp.Find("SMALL CART") Is Nothing Then
count = count + 1
Dim cartRow As Integer
cartRow = tmp.Find("SMALL CART").Row
If Not InStr(Cells(cartRow, 6).Text, "7") = 1 Then
Range(Cells(i, 3), Cells(i, 3)).Value = "Small Cart"
Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
Else
Range(Cells(i, 3), Cells(i, 3)).Value = "7000 Series"
Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
End If
If count = 0 Then
Range(Cells(i, 3), Cells(i, 3)).Value = "Other"
Range(Cells(i, 6), Cells(i, 6)).Value = "Standard"
End If
If count > 1 Then
Range(Cells(i, 3), Cells(i, 3)).Value = "Mixed"
End If
If Range(Cells(i, 20), Cells(i, 20)).Value > 10000 Then
Range(Cells(i, 5), Cells(i, 5)).Value = "Critical"
Else
Range(Cells(i, 5), Cells(i, 5)).Value = "Non Critical"
End If
Range(Cells(i, 10), Cells(i, 10)).Value = Range(Cells(i - 1, 4), Cells(i - 1, 4)).Value
Range(Cells(i, 7), Cells(i, 7)).Value = Range(Cells(i - 1, 13), Cells(i - 1, 13)).Value
Range(Cells(i, 14), Cells(i, 14)).Value = Range(Cells(i - 1, 14), Cells(i - 1, 14)).Value
Range(Cells(i, 13), Cells(i, 13)).Value = Range(Cells(i - 1, 15), Cells(i - 1, 15)).Value
Range(Cells(i, 16), Cells(i, 16)).Value = Range(Cells(i - 1, 16), Cells(i - 1, 16)).Value
' Ignore the totals rows by incrementing past it
i = i + 1
start = i
saved = Range(Cells(start, 2), Cells(start, 2)).Value
End If
Next i
' Bring Total rows from Tracker sheet into Master Tracker Workbook
' Paste into Sheet 2 first in order to only get total rows
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("B4:W4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("S1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("G1:G700")
' Set Aging Since Order Placement formula
Range("H1").Formula = "=IF(ISBLANK(A1), """", TODAY() - F1)"
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:H1011"), Type:=xlFillDefault
Range("H1:H1011").Select
Selection.NumberFormat = "General"
Range("A1:I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
' File Location
ChDir "C:\Users\etc."
' File Name
Workbooks.Open Filename:= _
"C:\Users\etc."
Sheets("Master Tracker").Select
Range("B11").Select
ActiveSheet.Paste
' Set the segment class for each order
' Formula goes to row 1011 to allow for 1000 orders
Range("D11").Formula = "=IF(ISBLANK(B11), """", IF(Q11=DATE(2000,1,1), ""UnSchd"", ""Scheduled""))"
Range("D11").Select
Selection.AutoFill Destination:=Range("D11:D1011"), Type:=xlFillDefault
Range("B11").Select
' Bring over remaining Dates
Windows("ORDER_LINE_SHEET").Activate
Range("L1:M1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MASTER_TRACKER_WORKBOOK").Activate
Range("L11").Select
ActiveSheet.Paste
Windows("ORDER_LINE_SHEET").Activate
Range("O1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MASTER_TRACKER_WORKBOOK").Activate
Range("Q11").Select
ActiveSheet.Paste
ActiveSheet.Unprotect
Range("J:J").WrapText = True
Range("B11").Select
End Sub
这有助于将新订单行转换为订单总计，但我无法覆盖已手动更新的单元格，并且无法将这些单元格与错误的订单行对齐。有什么想法吗？
谢谢！