我正在处理大型数据重新格式化宏。我正在使用包含各种数据的上传表，并将一个全新的工作簿转换为发送给外部用户的内容。我已经非常接近＆＃34;点击此按钮生成，＆＃34;除了最后一部分。
列F有数字，可能是重复，也许不是。如果列F有重复，我希望它将列G中的相应数量相加，并输出最后一个（H，＃）。然后它需要转到下一个数据并在那里测试重复数据。它也将围绕它的边界，虽然这不是困难的部分。
它应该从ws1.Range（＆＃34; F5＆＃34;）到ws1.Range（＆＃34; F＆＃34;＆amp; lRow + 5）进行测试，这是先前已经确定的。
因为它正在从上传数据中拉出lRow，这可能是识别终点的最简单方法，尽管lRow +1将是一个空行。但是对于求和，下一行可能总会有数据，因此扫描空单元格并没有帮助。
我试图用一段时间的声明来做，但我无法弄清楚如何进行测试循环＆＃39;对于重复项，作为整个表格的较大扫描的一部分。
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中打印11,518.70：H10，我需要清除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);_($* ""-""??_);_(@_)"
答案 0 :(得分：1)
好吧，对于有类似问题的人，这是我的解决方案。我根据是否存在重复值创建了详尽的解决方案集，并且每个都有不同的边界规定。我确定它不是最快的方式，但现在我有了可交付成果。
'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
Let PasteRange = "G5:H" & lRow + 4
ws1.Range(PasteRange).Borders.LineStyle = xlContinuous
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 = ""
ws1.Cells(i, 8).Borders(xlEdgeBottom).LineStyle = xlNone
ws1.Cells(i, 8).Borders(xlEdgeRight).LineStyle = xlNone
ws1.Cells(i, 8).Borders(xlEdgeLeft).LineStyle = xlNone
ws1.Cells(i, 7).Borders(xlEdgeBottom).LineStyle = xlNone
ws1.Cells(i, 7).Borders(xlEdgeRight).LineStyle = xlNone
ws1.Cells(i, 7).Borders(xlEdgeLeft).LineStyle = xlNone
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 = ""
ws1.Cells(i, 8).Borders(xlEdgeBottom).LineStyle = xlNone
ws1.Cells(i, 7).Borders(xlEdgeBottom).LineStyle = xlNone
ws1.Cells(i, 8).Borders(xlEdgeLeft).LineStyle = xlNone
ws1.Cells(i, 7).Borders(xlEdgeRight).LineStyle = xlNone
ws1.Cells(i + 1, 8).Borders(xlEdgeLeft).LineStyle = xlNone
ws1.Cells(i + 1, 7).Borders(xlEdgeRight).LineStyle = xlNone
End If
Next i
i = 5
For i = 5 To lRow + 4
If ws1.Cells(i, 6).Value <> ws1.Cells(i - 1, 6).Value And ws1.Cells(i, 6).Value = ws1.Cells(i + 1, 6).Value Then
ws1.Cells(i, 8).Borders(xlEdgeTop).LineStyle = xlContinuous
ws1.Cells(i, 7).Borders(xlEdgeTop).LineStyle = xlContinuous
End If
Next i
ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"