Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4065 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【58592】同じような手順をまとめたい まるん 08/10/30(木) 19:49

【58593】Re:同じような手順をまとめたい ichinose 08/10/30(木) 20:32

【58598】Re:同じような手順をまとめたい まるん 08/10/30(木) 22:10

【58604】Re:同じような手順をまとめたい ichinose 08/10/31(金) 7:02


	【58592】同じような手順をまとめたい

まるん - 08/10/30(木) 19:49 -


	引用なし

	パスワード

1月　　　　2月　　　　3月・・・　　　　　　　　12月　　　　担当
100　　　　200　　　　　　　　　　　　100　　　　田中
50　　　　45　　　　　　　　　　　　80　　　　佐藤
80　　　　78　　　　　　　　　　　　90　　　　池田
400　　　　30　　　　　　　　　　　　50　　　　田中
200　　　　36　　　　　　　　　　　　40　　　　清水
80　　　　34　　　　　　　　　　　　67　　　　佐藤
70　　　　12　　　　　　　　　　　　45　　　　平井

上記のようなエクセルがあります。
別シート（シート名は"一覧"）に担当ごとに各月の合計を
転記したく、コードを書きました。

転記結果です。
担当　　　　1月　　　　2月　　　　3月・・　　　　12月
田中　　　　500　　　　230　　　　　　　　150
佐藤　　　　130　　　　79　　　　　　　　147

が、担当は30名ほどいて
私のこのコードでは
まとまりがなく、無駄なようでわかりにくいのです。

なにかいい知恵がございましたら
ぜひ教えていただきたく、書かせて頂きました。
よろしくお願いいたします。

Sub test()
Dim MRow As Long
Dim Rng As Range
Dim A, B, C, D, E, F, G, H, I, J, K, L As Variant
Dim A1, B1, C1, D1, E1, F1, G1, H1, I1, J1, K1, L1 As Variant

MRow = Cells(65536, 1).End(xlUp).Row
For Each Rng In Range(Cells(2, 13), Cells(MRow, 13))
　　If Rng.Value = "田中" Then
　　　 A = A + Rng.Offset(, -12)
　　　 B = B + Rng.Offset(, -11)
　　　 C = C + Rng.Offset(, -10)
　　　 D = D + Rng.Offset(, -9)
　　　：
　　　 K = K + Rng.Offset(, -2)
　　　 L = L + Rng.Offset(, -1)
　　　 Worksheet("一覧").Range("B2").Resize(, 12) = Array(A, B, C, D, E, F, G, H, I, J, K, L)
　　　
　　ElseIf Rng.Value = "佐藤" Then
　　　 A1 = A1 + Rng.Offset(, -12)
　　　 B1 = B1 + Rng.Offset(, -11)
　　　 C1 = C1 + Rng.Offset(, -10)
　　　 D1 = D1 + Rng.Offset(, -9)
　　　：
　　　 K1 = K1 + Rng.Offset(, -2)
　　　 L1 = L1 + Rng.Offset(, -1)
　　　 Worksheet("一覧").Range("B3").Resize(, 12) = Array(A1, B1, C1, D1, E1, F1, G1, H1, I1, J1, K1, L1)

　　'Eleseifが人数分続きます。

　　End If
Next

End Sub


	【58593】Re:同じような手順をまとめたい

ichinose - 08/10/30(木) 20:32 -


	引用なし

	パスワード

▼まるんさん：
こんばんは。

>1月　　　　2月　　　　3月・・・　　　　　　　　12月　　　　担当
>100　　　　200　　　　　　　　　　　　100　　　　田中
>50　　　　45　　　　　　　　　　　　80　　　　佐藤
>80　　　　78　　　　　　　　　　　　90　　　　池田
>400　　　　30　　　　　　　　　　　　50　　　　田中
>200　　　　36　　　　　　　　　　　　40　　　　清水
>80　　　　34　　　　　　　　　　　　67　　　　佐藤
>70　　　　12　　　　　　　　　　　　45　　　　平井
>
>上記のようなエクセルがあります。
↑このシートをアクティブにした状態で以下のコードを実行してください。

標準モジュールに

'===========================================================
Sub main()
　　Dim rngA As Range
　　Dim rngB As Range
　　Set rngA = Range("m1", Cells(Rows.Count, "m").End(xlUp))
　　rngA.AdvancedFilter xlFilterCopy, , Worksheets("一覧").Range("a1"), True
　　With Worksheets("一覧")
　　　 With .Range("b1:m1")
　　　　　.Formula = "=column()-1&""月"""
　　　　　.Value = .Value
　　　　　End With
　　　 Set rngB = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
　　　 If rngB.Row > 1 Then
　　　　　With rngB.Offset(0, 1).Resize(, 12)
　　　　　　 .Formula = "=sumif(" & rngA.Address(, , , True) & ",$a2," & _
　　　　　　　　　　　rngA.Offset(, -12).Address(, False, , True) & ")"
　　　　　　 'セルb2には、=SUMIF(元データシート名!$M$1:$M$8,$A2,元データシート名!A$1:A$8)
　　　　　　 .Value = .Value
　　　　　　 End With
　　　　　End If
　　　 End With
End Sub


	【58598】Re:同じような手順をまとめたい

まるん - 08/10/30(木) 22:10 -


	引用なし

	パスワード

▼ichinose さん：
ご返信ありがとうございます。
理解できないところがあり、再度質問させていただきます。
お手数をかけてしまい、申し訳ございません。

> .Formula = "=sumif(" & rngA.Address(, , , True) & ",$a2," & _
>　　rngA.Offset(, -12).Address(, False, , True) & ")"

Address後の（）部分が何を示しているのかがわからないのです。
ヘルプを見ると
式.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
で絶対参照を返す？など書かれていますが・・・

教えていただけますでしょうか？
よろしくお願いいたします。


	【58604】Re:同じような手順をまとめたい

ichinose - 08/10/31(金) 7:02 -


	引用なし

	パスワード

▼まるんさん：
おはようございます。

>Address後の（）部分が何を示しているのかがわからないのです。
>ヘルプを見ると
>式.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
>で絶対参照を返す？など書かれていますが・・・

実際にAddress()内に値を指定してその結果を考察してみるとよいでしょう！！

新規ブック（Sheet1とSheet2というシート名が存在するブック）の標準モジュールに

'===========================================================
Sub main()
　　Dim g0 As Long
　　Dim rng As Range
　　Worksheets("sheet1").Activate
　　Set rng = mk_sample(Worksheets("Sheet1"))
　　MsgBox "サンプルデータをSheet1に作成　これからSheet2で参照します"
　　With Worksheets("sheet2")
　　　 .Activate
　　　 With .Range("c1:d1,e1:f1,g1:h1,i1:j1,k1:l1")
　　　　　.MergeCells = True
　　　　　.Areas(1).Value = "Address()"
　　　　　
　　　　　.Areas(2).Value = "Address(,,,true)"
　　　　　.Areas(3).Value = "Address(, False)"
　　　　　.Areas(4).Value = "Address(, False,,true)"
　　　　　.Areas(5).Value = "Address(false,false,,true)"
　　　　　End With
　　　 .Range("c2:d10").Formula = "=" & rng.Address
　　　 .Range("e2:f10").Formula = "=" & rng.Address(, , , True)
　　　 .Range("g2:h10").Formula = "=" & rng.Address(, False)
　　　 .Range("i2:j10").Formula = "=" & rng.Address(, False, , True)
　　　 .Range("k2:l10").Formula = "=" & rng.Address(False, False, , True)
　　　End With
　　　
End Sub
'======================================================================
Function mk_sample(sht As Worksheet) As Range
　　With sht.Range("a2:b10")
　　　 .Formula = "=int(rand()*1000)+1"
　　　 .Value = .Value
　　　 Set mk_sample = .Cells(1, 1)
　　　 End With
End Function

mainを実行してみてください。

上記コード例は、Sheet1のセルＡ２、

つまり、

Worksheets("Sheet1").Range("A2")

のAddressプロパティの()内の値をいくつか変えて指定した結果が

Sheet2に表示されています。

Addressプロパティの指定内容と実際にセルに指定された数式や値の違いを
よく見比べてみてください。

セルに対して、Addressの()内の値を変える事により、

セル番地を絶対番地や相対番地にしています。

Excelの絶対番地や相対番地は、これは算数で言えば九九、英語のＡＢＣですから、
意味は良く調べてみてください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4065 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free