VBA使用非空单元格和循环数组求和variables范围

我正在处理一个大的数据重新格式化macros。 我正在上传一张带有各种数据的表单,并将一个全新的工作簿变成一些发送给外部用户的东西。 我已经非常接近“点击这个button来生成”,除了最后一部分。

F列有数字,也许重复,也许不是。 如果列F有重复,我想它列G中相应的金额和最后(H,#)输出。 然后它需要去下一个数据,并在那里testing重复。 它也将围绕它的边界,虽然这不是困难的部分。

它应该testing从ws1.Range(“F5”)到ws1.Range(“F”&lRow + 5),这已经在之前被识别了。

因为它是从上传数据中提取的,所以这可能是识别终点的最简单的方法,尽pipelRow + 1将是一个空行。 但是为了总结,下一行可能总是有数据,所以扫描空单元不会有帮助。

Excel表格的图像

我试图做一个while语句,但我不知道如何做重复testing循环作为整个表的更大扫描的一部分。

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 

我真的不确定最好的方法。

感谢您的任何见解!

编辑:

下面是我见过的最类似问题的另一个链接,但略有不同: 类似

这是我的代码,完整的,任何审查,但它是相当冗长,这是在它的底部,所以我不知道它创造了任何价值:

 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:我链接的另一个post是我想要的过程,但我需要一个后续删除所有非最终值,其中包括任何非重复的发票以及重复的第一次迭代(意思是否它在H5:H10中打印11,518.70,我需要清除H5:H9)。 我也不知道如何使用这种方式格式化框。

编辑3:

这是我的部分解决scheme。 唯一不能实现的(我不知道怎么做)是在发票的周围创build箱子。

 '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);_($* ""-""??_);_(@_)" 

好吧,对于有类似问题的人,这里是我的解决scheme。 我根据是否有重复的值创build了详尽的解决scheme集,并且对每个边界条款都有不同的规定。 我相信这不是最快的方法,但现在我有一个可交付的。

 '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);_($* ""-""??_);_(@_)"