1
大規模なデータ書式変更マクロで作業しています。私は、さまざまなデータをアップロードしたシートを取って、まったく新しいワークブックを外部のユーザーに送信するものにしています。私はこの最後の部分を除いて "生成するにはこのボタンをクリック"するのとかなり近いです。VBA可変範囲を空でないセルと配列でループする
列Fには数字があり、重複している可能性があります。 IF列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);_($* ""-""??_);_(@_)"