| 
    
     |  | ▼愛子 さん: 
 こんにちは
 
 >前から思っていた事ですが、
 >コードを入力している皆様は、沢山のコードを一文字、一文字手入力しているのでしょうか?
 
 私の場合は、98%ぐらいは手打ちですね。
 もちろん、年とともに物忘れが激しくなってきていますので、引数がたくさんあるメソッドなんかは
 あれ?どうだったかな? こんな時は、その部分だけのマクロ記録をとってコードを生成して
 それをコピペ。
 あるいは、これは使えそうだなと思うコード部品を、自分用のライブラリーとしてファイルしているんですが
 そこから、1〜2行、コピペ。
 
 こんなことはありますね。
 
 
 さて、コードです。
 一致シートの2行目が縦合計行。B3以降のB列には、それぞれの行の横合計の式がはいっているものとします。
 
 Sub 集計から一致のシートに金額転記3()
 Dim c As Range
 Dim i As Long
 Dim dic As Object
 Dim mm As Long
 Dim nameV As Variant
 Dim mmV As Variant
 Dim z As Long
 
 Do
 mm = Application.InputBox("作業する月をいれてください", Type:=1)
 If mm = 0 Then Exit Sub 'キャンセルボタン
 Select Case mm
 Case 1 To 12
 Exit Do
 End Select
 MsgBox "1〜12の範囲で入力してくださいね"
 Loop
 
 If mm < 4 Then mm = mm + 12
 
 Set dic = CreateObject("Scripting.Dictionary")
 
 With Sheets("集計")
 '集計シートの名前と金額をDictionaryに格納(2行目以降)
 For Each c In .Range("E2", .Range("E" & .Rows.Count).End(xlUp))
 dic(c.Value) = dic(c.Value) + c.EntireRow.Range("L1").Value
 Next
 End With
 
 With Sheets("一致")
 '一致シートの A列と当該月列の内容(2行目以降)を配列に格納
 With .Range("A3", .Range("A" & .Rows.Count).End(xlUp))
 nameV = .Value
 mmV = .Offset(, mm - 2).Value
 For i = 1 To UBound(nameV, 1)
 If dic.exists(nameV(i, 1)) Then mmV(i, 1) = dic(nameV(i, 1))
 Next
 .Offset(, mm - 2).Value = mmV
 z = .Rows.Count
 End With
 
 .Range("B2:N2").FormulaR1C1 = "=SUM(r[1]c:r[" & z & "]c)"
 .Select
 
 End With
 
 MsgBox "集計が終わりました"
 Sheets("入力伝票").Select
 
 End Sub
 
 |  |