| |
コメントを丁寧につけて、書いていただいてありがとうございます。
何度も何度もやってみました。
ただ、私の理解が乏しく、編集するのが困難だったため、
先にコメントいただいた方のを使用させていただきました。
プラスアルファ自動記録を使ってみたのですが、
どうもごちゃごちゃしてしまって。
最終行を取得して、罫線を引いたり、リストの先頭行を中央揃えなど、
行を取得し･･･というのがなぜかエラーになってしまったので、
結果、自動記録しかないという結論に至りました。
見ていただいて、ご意見ご指導をいただけると嬉しいです！！
Sub Sample()
Dim v As Variant
Dim z As Long
Dim i As Long
Dim k As Long
Dim dic As Object
Dim dKey As String
Dim c As Range
Dim w As Variant
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("集計")
z = .Range("A1").CurrentRegion.Rows.Count - 1
ReDim v(1 To z, 1 To 6)
For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
dKey = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
If Not dic.exists(dKey) Then
dic(dKey) = dic.Count + 1
i = dic(dKey)
v(i, 1) = c.Value
v(i, 2) = c.Offset(, 1).Value
v(i, 3) = c.Offset(, 2).Value
v(i, 4) = c.Offset(, 3).Value
End If
i = dic(dKey)
v(i, 5) = v(i, 5) + c.Offset(, 4).Value
v(i, 6) = v(i, 6) + c.Offset(, 5).Value
Next
End With
With Sheets("集計合計")
.Cells.ClearContents
.Range("A1:F1").Value = Sheets("集計").Range("A1:F1").Value
.Range("A2").Resize(dic.Count, 6).Value = v
.Rows(2).Resize(dic.Count).sort key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo
.Range("A" & dic.Count + 2).Value = "合計"
.Range("F" & dic.Count + 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Select
End With
Columns("A:F").EntireColumn.AutoFit
Application.ScreenUpdating = True
Set dic = Nothing
MsgBox "合計処理が完了しました"
End Sub
Sub 罫線() 'リストの最終行まで罫線を引く
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Selection.End(xlDown).Select
Range("A47:E47").Select '最終行の"合計"が入るセルとその右隣の5つのセルを選択し、範囲内で中央揃えを使用とした結果です。
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A47").Select
Selection.End(xlUp).Select
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
End Sub
|
|
ゆうか
- 12/2/25(土) 0:56 -
