我编写了一个宏，它从一个电子表格中获取订单行，对它们进行小计，然后将订单总计传输到主跟踪器。然后，主跟踪器中的列和字段需要手动更新。
我被告知，宏将不再仅引用带有订单行的电子表格，而是需要引用前一天（最新）版本的跟踪器的跟踪器，并将订单行与该跟踪器匹配. 手动更新的单元格需要与它们引用的顺序保持一致。
我面临的问题是电子表格的合并。带有订单行的电子表格将包含主跟踪器上已有的订单，以及一些新订单。我根据订单号对订单行进行排序，订单号是字母和数字的组合。因此，我不能只锁定单元格并将新订单添加到底部（新的演示订单将排序在先前存在的服务订单之上，将服务订单下推并丢弃锁定中的任何数据细胞）。
有没有办法维护跟踪器每一行中的数据，同时仍向主跟踪器插入和添加新的订单详细信息？
这是宏的原样（未提及手动输入字段）：
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
这将有助于将新订单行转换为订单总计，但我无法覆盖已手动更新的单元格，也无法让这些单元格与错误的订单行对齐。有什么想法吗？
谢谢！