| |
▼菜実 さん：
>上半期のシートが出来上がり、下半期を作成している途中なのですけど
>下記のヒントをいただいていましたが、どのように修正すればいいか分からず
>「何列目」に 加算すればよいか と言うことを教えていただき、
>単純に m ＝ 月数-9 としてみましたがどうも違うようで、涙目です。
先ほど、いちど付け焼刃の案をアップしましたが、不具合をみつけたので、
一度削除して、もうす少しはマシなのを再掲します。
一番最初に、上半期か 下半期かInputBoxで問い合わせがありますので、
ここで集計する最初の月を数字で入れてください（通常、4 か 10;
ただし、1〜12 の有効な月数ならどれでもかまいません。指定の月から
6か月分を集計します)
◆印が主な変更か所です
Sub Try5() '月の列番号も dic に記憶
Dim r As Range
Dim Code, Price, Cat, Mon
Dim i As Long, m As Long, n As Long, numRecords As Long, k As Long
Dim dic As Object
Dim mCol As Long '◆表示列番号
Dim BeginMonth As Integer '◆上半期なら 4 下半期なら 10 とする
'◆最初の月数をインプット
BeginMonth = Val(InputBox("何月から半期分の集計？", , 10))
Select Case BeginMonth
Case 1 To 12
Case Else: Exit Sub
End Select
Set r = Range("A1").CurrentRegion
With Application
Set r = .Intersect(r, r.Offset(1)) '1行目をカット
Code = .Transpose(r.Columns("E")) 'コード (文字列)
Price = .Transpose(r.Columns("I")) '発注額
Cat = .Transpose(r.Columns("J")) '区分
Mon = .Transpose(r.Columns("H")) '納期
End With
numRecords = UBound(Code)
ReDim Ans(numRecords, 6)
Ans(0, 0) = "コード" '0行目に 列見出し
Set dic = CreateObject("Scripting.Dictionary")
'列見出し 月名の代入
For i = BeginMonth To BeginMonth + 5 '◆半期分
m = i: If m > 12 Then m = m - 12 '◆
mCol = i - BeginMonth + 1 '◆
dic(MonthName(m)) = mCol '◆ (下)10月が1列目
Ans(0, mCol) = MonthName(m) & "計" '◆
Next
'コード別に集計
For i = 1 To numRecords
If dic.Exists(Code(i)) Then '既存のコードのときは
n = dic(Code(i)) '表の行番号をdicから得る
Else
k = k + 1 '新規コード なら コードと(行番号)を登録
dic(Code(i)) = k
Ans(k, 0) = Code(i)
n = k
End If
Select Case Cat(i) '区分が「A」または「B」のときだけ集計
Case "A", "B"
m = Month(Mon(i))
If dic.Exists(MonthName(m)) Then '◆
mCol = dic(MonthName(m))
Ans(n, mCol) = Ans(n, mCol) + Price(i)
End If
End Select
Next
With Range("M1").Resize(k + 1, 7)
.ClearContents
.NumberFormat = "#,##0"
.Columns(1).NumberFormat = "@"
.Value = Ans
End With
End Sub
|
|
kanabun
- 08/7/11(金) 19:52 -
