| |
▼ゆうか さん：
こんにちは
>タイトル行（C10:H10）がおかしな位置に移動してしまって
ではなく、｢合計行が｣ではないですか？
それと、罫線がひかれなくなっていません？
少しわかりにくかったかもしれませんが、たとえば集約したデータ件数が7件だったとします。
この7という数字は、Dictionaryデータの件数としてdic.Countというところに格納されています。
もともとがA1から始まっていましたので、データが7件だとするとデータ領域は A2:A8 ですよね。
なので、A2:F & dic.count+1 でしたし、"合計"という文字をセットする場所は A9 ですから
A & dic.count+2 という場所の指定になっていました。
今回、開始はC列、10行目ということですから、このあたりを全て変更しておく必要があります。
訂正箇所のみを連絡してもいいのですが、かえってわかりにくくなりますので、コードを全て。
訂正箇所には★印をつけてあります。
ところで、.Columns("C:H").EntireColumn.AutoFit
これは、あらかじめ"請求書"シートのC〜H列の列幅を"集約"シートのA〜F列とと同じにしておけば
コードはいらないと思いますが？
Sub 請求書作成()
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("C10:H10").Value = Sheets("集計").Range("A1:F1").Value
.Range("C11").Resize(dic.Count, 6).Value = v
.Rows(2).Resize(dic.Count).sort key1:=.Range("C11"), Order1:=xlAscending, Header:=xlNo
.Range("C10").Offset(dic.Count + 1).Value = "合計" '★訂正
.Range("H10").Offset(dic.Count + 1).FormulaR1C1 = "=SUM(R2C:R[-1]C)" '★訂正
'============ 罫線他の書式設定 開始
.Cells.Borders.LineStyle = xlNone 'すでにひかれている罫線があればそれを削除
'1行目 タイトル行 ★あらかじめ書式設定しておけば、コード処理は不要
With .Range("C10:H10")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'合計行
With .Range("C10").Offset(dic.Count + 1) '★訂正
.Resize(, 5).HorizontalAlignment = xlCenterAcrossSelection
.Offset(, 5).HorizontalAlignment = xlRight
.Resize(, 6).VerticalAlignment = xlCenter
End With
'データ領域
With .Range("C11").Resize(dic.Count, 3) '★訂正
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With .Range("F11").Resize(dic.Count, 3) '★訂正
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
'罫線
With .Range("C10").CurrentRegion.Borders '★訂正
.LineStyle = xlContinuous
.Weight = xlThin
End With
.Columns("C:H").EntireColumn.AutoFit '★これは、あらかじめ書式設定しておけばコード処理は不要
'============ 罫線他の書式設定 終了
.Select
End With
Application.ScreenUpdating = True
Set dic = Nothing
MsgBox "合計処理完了"
End Sub
|
|
UO3
- 12/3/1(木) 10:17 -
