1
我正在處理大型數據重新格式化宏。我正在上傳一張包含各種數據的表單，並將一個全新的工作簿製作成發送給外部用戶的內容。我已經非常接近「點擊這個按鈕來生成」，除了最後一部分。VBA將可變範圍與非空單元和循環陣列相加
列F有數字，也許重複，也許不是。如果F列有重複項，我希望它將G列中的相應數量相加並在最後一個（H，＃）中輸出。然後它需要轉到下一個數據並在那裏測試重複數據。它也會將邊界放在其周圍，儘管這不是困難的部分。
它應該從ws1.Range（「F5」）到ws1.Range（「F」& lRow + 5），它已經在前面已經確定。
因爲它是從上傳數據中提取lRow，這可能是識別終點的最簡單方法，但lRow + 1將是空行。但是爲了總結，下一行可能總是有數據，因此掃描空單元格不會有幫助。
我試圖用while語句來做到這一點，但我無法弄清楚如何做重複的「測試循環」作爲整個表的掃描較大的一部分。
Let i = 5
While i < lRow + 5
If ws1.Cells(i, 6) = ws1.Cells(i + 1, 6) Then
Let CopyRange = ws1.Cells(i, 7) & ":" & ws1.Cells(i + 1, 7)
Let PasteRange = ws1.Cells(i + 1, 8)
ws1.Range(PasteRange).Formula = "=Sum(CopyRange)"
i = i + 1
End If
Wend
我真的不確定最好的方法來處理。
謝謝任何見解！
編輯：
這裏是另一個鏈接到我見過的最類似的問題，但它是略有不同：Similar
這裏是我的代碼，在全面，對於任何的評論，但是它是相當漫長這是在它的最底層，所以我不知道它創造任何價值：
Sub ConvertToFundingRequest()
Dim wb As Workbook, og As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, os As Worksheet, os2 As Worksheet, os3 As Worksheet
Dim lRow As Long, i As Long, endRow As Long, lastSearch1 As Long, lastSearch2 As Long, lastSearch3 As Long, first As Long, last As Long
Dim CopyRange As String, PasteRange As String, searchValue As String
'Create the new workbook
Set og = ThisWorkbook
Set os = og.Worksheets("Upload Sheet")
Set os2 = og.Worksheets("Instructions")
Set os3 = og.Worksheets("Vendors")
Set wb = Workbooks.Add
wb.Worksheets.Add
Application.DisplayAlerts = False
'wb.Sheets("Sheet2").Delete
'wb.Sheets("Sheet3").Delete
Application.DisplayAlerts = True
Set ws1 = wb.Worksheets(1)
Set ws2 = wb.Worksheets(2)
Application.ScreenUpdating = False
ws2.Activate
ActiveWindow.Zoom = 85
ws1.Activate
ActiveWindow.Zoom = 85
Application.ScreenUpdating = True
ws1.Name = "Funding in Total"
ws2.Name = "Funding by Property"
'Format the cells to look like funding request
ws1.Columns("A").ColumnWidth = 38
ws1.Columns("B").ColumnWidth = 55
ws1.Columns("C:E").ColumnWidth = 13
ws1.Columns("F").ColumnWidth = 21
ws1.Columns("G").ColumnWidth = 16
ws1.Columns("H").ColumnWidth = 13
ws1.Columns("I").ColumnWidth = 9
ws1.Rows("1").RowHeight = 27
ws1.Range("A1:B1").Merge
ws1.Range("A1").Font.Size = 12
ws1.Range("A1").Font.Name = "Calibri"
ws1.Range("A1").Font.FontStyle = "Bold"
ws1.Range("C1:G1").Merge
ws1.Range("C1:G1").Font.Size = 20
ws1.Range("C1:G1").Font.Name = "Calibri"
ws1.Range("C1:G1").Font.FontStyle = "Bold"
ws1.Range("C1:G1").Borders.LineStyle = xlContinuous
ws1.Range("C1:G1").Borders.Weight = xlMedium
ws1.Range("C1:G1").HorizontalAlignment = xlCenter
ws1.Range("C1:G1").Interior.Color = RGB(255, 255, 153)
'Create the table title formatting
ws1.Range("A4:H4").Font.Underline = xlUnderlineStyleSingle
ws1.Range("A4:H4").Font.Size = 12
ws1.Range("A4:H4").Font.Name = "Calibri"
ws1.Range("A4:H4").Font.FontStyle = "Bold"
ws1.Range("H3").Font.Size = 12
ws1.Range("H3").Font.Name = "Calibri"
ws1.Range("H3").Font.FontStyle = "Bold"
'Create those headers with the formatting
ws1.Cells(1, 1).Value = "Church Street Funding Request " & Format(Now(), "mmmm dd, yyyy")
ws1.Cells(1, 3).Value = "In Total"
ws1.Cells(3, 8).Value = "Invoice"
ws1.Cells(4, 1).Value = "Vendor"
ws1.Cells(4, 2).Value = "Invoice Notes"
ws1.Cells(4, 3).Value = "Property"
ws1.Cells(4, 4).Value = "Date"
ws1.Cells(4, 5).Value = "Account"
ws1.Cells(4, 6).Value = "Invoice Number"
ws1.Cells(4, 7).Value = "Amount"
ws1.Cells(4, 8).Value = "Total"
'Build out data array from original worksheet
lRow = os.Cells(Rows.Count, 1).End(xlUp).Row 'identifies last row to copy data from
'Copy Vendor Codes
Let CopyRange = "C2:C" & lRow + 1
Let PasteRange = "A5:A" & lRow + 5
os3.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Invoice Date
Let CopyRange = "E1:E" & lRow
Let PasteRange = "D5:D" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).NumberFormat = "m/d/yyyy;@"
'Copy Invoices Notes
Let CopyRange = "H1:H" & lRow
Let PasteRange = "B5:B" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Property Code
Let CopyRange = "I1:I" & lRow
Let PasteRange = "C5:C" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Invoice Number
Let CopyRange = "G1:G" & lRow
Let PasteRange = "F5:F" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy GL Account
Let CopyRange = "K1:K" & lRow
Let PasteRange = "E5:E" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Replace what:="-", Replacement:="", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
'Copy Amount
Let CopyRange = "J1:J" & lRow
Let PasteRange = "G5:G" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
'Copy Segment
Let CopyRange = "V1:V" & lRow
Let PasteRange = "I5:I" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Format the bottom part of funding request where the totals are
Let PasteRange = "C" & lRow + 6 & ":F" & lRow + 6
ws1.Range(PasteRange).Merge
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Value = "TOTAL VENDOR PAYMENTS"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)
Let PasteRange = "C" & lRow + 12 & ":F" & lRow + 12
ws1.Range(PasteRange).Merge
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Value = "TOTAL TO BE PAID OTHER"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)
Let PasteRange = "C" & lRow + 15 & ":F" & lRow + 15
ws1.Range(PasteRange).Merge
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Value = "TOTAL FUNDING REQUEST"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble
ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)
Let PasteRange = "B" & lRow + 15 & ":B" & lRow + 15
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble
Let PasteRange = "G" & lRow + 6 'Summing the Amounts
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Formula = "=SUM(G5:G" & lRow + 5 & ")"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
Let PasteRange = "G" & lRow + 12 'Summing Sales Tax/Other
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Formula = "=SUM(G" & lRow + 8 & ":G" & lRow + 10 & ")"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Let PasteRange = "G" & lRow + 15 'Grand Sum
ws1.Range(PasteRange).Font.Size = 14
ws1.Range(PasteRange).Font.Name = "Calibri"
ws1.Range(PasteRange).Font.FontStyle = "Bold"
ws1.Range(PasteRange).Formula = "=SUM(G" & lRow + 6 & "+G" & lRow + 12 & ")"
ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble
ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
'This completes all the base formatting for the Funding Request
'''''''''''''''''''''
'Lets start to modify the data. We'll start with the second sheet.
'Again, starting with Formatting
'Format the cells to look like funding request
ws2.Columns("A").ColumnWidth = 38
ws2.Columns("B").ColumnWidth = 55
ws2.Columns("C:E").ColumnWidth = 13
ws2.Columns("F").ColumnWidth = 21
ws2.Columns("G").ColumnWidth = 16
ws2.Rows("1").RowHeight = 27
ws2.Range("A1:B1").Merge
ws2.Range("A1").Font.Size = 12
ws2.Range("A1").Font.Name = "Calibri"
ws2.Range("A1").Font.FontStyle = "Bold"
ws2.Range("C1:G1").Merge
ws2.Range("C1:G1").Font.Size = 20
ws2.Range("C1:G1").Font.Name = "Calibri"
ws2.Range("C1:G1").Font.FontStyle = "Bold"
ws2.Range("C1:G1").Borders.LineStyle = xlContinuous
ws2.Range("C1:G1").Borders.Weight = xlMedium
ws2.Range("C1:G1").HorizontalAlignment = xlCenter
ws2.Range("C1:G1").Interior.Color = RGB(255, 255, 153)
'Create the table title formatting
ws2.Range("A3:G3").Font.Underline = xlUnderlineStyleSingle
ws2.Range("A3:G3").Font.Size = 12
ws2.Range("A3:G3").Font.Name = "Calibri"
ws2.Range("A3:G3").Font.FontStyle = "Bold"
ws2.Range("A3:G3").Borders(xlEdgeBottom).LineStyle = xlContinuous
'Create those headers with the formatting
ws2.Cells(1, 1).Value = "Church Street Funding Request " & Format(Now(), "mmmm dd, yyyy")
ws2.Cells(1, 3).Value = "By Property"
ws2.Cells(3, 1).Value = "Vendor"
ws2.Cells(3, 2).Value = "Invoice Notes"
ws2.Cells(3, 3).Value = "Property"
ws2.Cells(3, 4).Value = "Date"
ws2.Cells(3, 5).Value = "Account"
ws2.Cells(3, 6).Value = "Invoice Number"
ws2.Cells(3, 7).Value = "Amount"
'Copy Data
Let CopyRange = "A5:G" & lRow + 5
Let PasteRange = "A5:G" & lRow + 5
ws1.Range(CopyRange).Copy
ws2.Range(PasteRange).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range(PasteRange).HorizontalAlignment = xlLeft
ws1.Range(PasteRange).Font.Size = 11
ws1.Range(PasteRange).Font.Name = "Calibri"
'Sort Data
ws2.Range("C4").Value = "Site"
ws2.Range("A4:G4").AutoFilter
ws2.AutoFilter.Sort.SortFields. _
Clear
ws2.AutoFilter.Sort.SortFields. _
Add Key:=Range("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ws2.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ws2.Range("A4:G4").AutoFilter
ws2.Range("C4").Value = ""
'Find where -02 ends and label
searchValue = "2350-02"
With ws2
endRow = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To endRow
If .Cells(i + 4, 3) = searchValue Then
lastSearch1 = i
End If
Next i
End With
Let PasteRange = lastSearch1 + 5 & ":" & lastSearch1 + 7
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch1 + 6 & ":G" & lastSearch1 + 6
ws2.Range(PasteRange).Font.Size = 14
ws2.Range(PasteRange).Font.Name = "Calibri"
ws2.Range(PasteRange).Font.FontStyle = "Bold"
ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
Let PasteRange = "B" & lastSearch1 + 6
ws2.Range(PasteRange).Value = "Total 2350-02"
Let PasteRange = "G" & lastSearch1 + 6
ws2.Range(PasteRange).Formula = "=Sum(G5:G" & lastSearch1 + 5 & ")"
'Find where -03 ends and label
searchValue = "2350-03"
With ws2
endRow = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To endRow
If .Cells(i + lastSearch1 + 7, 3) = searchValue Then
lastSearch2 = i + lastSearch1 + 7
End If
Next i
End With
Let PasteRange = lastSearch2 + 1 & ":" & lastSearch2 + 3
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch2 + 2 & ":G" & lastSearch2 + 2
ws2.Range(PasteRange).Font.Size = 14
ws2.Range(PasteRange).Font.Name = "Calibri"
ws2.Range(PasteRange).Font.FontStyle = "Bold"
ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
Let PasteRange = "B" & lastSearch2 + 2
ws2.Range(PasteRange).Value = "Total 2350-03"
Let PasteRange = "G" & lastSearch2 + 2
ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch1 + 8 & ":G" & lastSearch2 + 1 & ")"
'Find where -04 ends and label
searchValue = "2350-04"
With ws2
endRow = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To endRow
If .Cells(i + lastSearch2 + 4, 3) = searchValue Then
lastSearch3 = i + lastSearch2 + 4
End If
Next i
End With
Let PasteRange = lastSearch3 + 1 & ":" & lastSearch3 + 3
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch3 + 2 & ":G" & lastSearch3 + 2
ws2.Range(PasteRange).Font.Size = 14
ws2.Range(PasteRange).Font.Name = "Calibri"
ws2.Range(PasteRange).Font.FontStyle = "Bold"
ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
Let PasteRange = "B" & lastSearch3 + 2
ws2.Range(PasteRange).Value = "Total 2350-04"
Let PasteRange = "G" & lastSearch3 + 2
ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch2 + 4 & ":G" & lastSearch3 + 1 & ")"
'Finish off The by Property Tab
Let PasteRange = "A" & lastSearch3 + 4 & ":G" & lastSearch3 + 4
ws2.Range(PasteRange).Font.Size = 14
ws2.Range(PasteRange).Font.Name = "Calibri"
ws2.Range(PasteRange).Font.FontStyle = "Bold"
ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
Let PasteRange = "B" & lastSearch3 + 4
ws2.Range(PasteRange).Value = "Total Funding Request"
Let PasteRange = "G" & lastSearch3 + 4
ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch1 + 6 & " + G" & lastSearch2 + 2 & " + G" & lastSearch3 + 2 & ")"
'The property tab should now be completely formatted (except Sales Tax, which is a manual entry
''''''''''''''''''
'Only thing remaining is to do the combined invoices thing.
Let i = 5
'While i < lRow + 5
If ws1.Cells(i, 6) = ws1.Cells(i + 1, 6) Then 'And ws1.Cells(i, 6) = ws1.Cells(i + 2, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 3, 6) And _
'ws1.Cells(i, 6) = ws1.Cells(i + 4, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 5, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 6, 6) And _
'ws1.Cells(i, 6) = ws1.Cells(i + 7, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 8, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 9, 6) Then
Let CopyRange = ws1.Cells(i, 7) & ":" & ws1.Cells(i + 1, 7)
Let PasteRange = ws1.Cells(i + 1, 8)
ws1.Range(PasteRange).Value = CopyRange
i = i + 1
'
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
' If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
End If
'Wend
ws2.Range("Z1").Copy
End Sub
編輯2：其他的文章中，我掛是我想要的過程，但我需要後續刪除所有非最終值，其中包括任何非重複值發票以及重複的第一次迭代（意思是如果它在H5：H10中打印11,518.70，我需要清除H5：H9）。我也不知道如何使用這種方式格式化盒子。
編輯3：
這是我的部分解決方案。唯一不能實現的（我不知道如何），是在發票的周圍創建箱子。
'Only thing remaining is to do the combined invoices thing.
With ws1.Range("H5:H" & lRow + 4)
.ClearContents
.Value = ws1.Evaluate("INDEX(SUMIF(F5:F" & lRow + 4 & ",F5:F" & lRow + 4 & ",G5:G" & lRow + 4 & "),)")
End With
i = 5
For i = 5 To lRow + 4
If ws1.Cells(i, 7).Value = ws1.Cells(i, 8).Value Then
ws1.Cells(i, 8).Value = ""
End If
Next i
i = 5
For i = 5 To lRow + 4
If ws1.Cells(i, 8).Value = ws1.Cells(i + 1, 8).Value Then
ws1.Cells(i, 8).Value = ""
End If
Next i
Let PasteRange = "H5:H" & lRow + 4
ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"