すぐに役立つエクセルVBAマクロ集 FAQ 別シートに会社別としてまとめる

　すぐマク　YNxv98242

各データの会社コードにより別シートに会社別としてまとめるには？

Ｑuestion 74.9　値の操作

Excel VBA Borad （掲示板）より

　Sheet1　　　　　　　　　　　　Sheet2

Sheet1の情報をSheet2に貼り付けるのですが、Sheet1のA列には会社コードが入っており、重複しているコードもあります。

Sheet2には、会社コードは重複しないようにして、同じコードの社員名をB列以降の列に貼るつけたいのですが、（データー数は1000件くらい）

どのようにプロシージャを組めばよろしいでしょうか？

Ａnswer　　

2005.6.17　もてもて

1会社255人を超えるとエラーになりますけど、こんな感じ。

Sub test()
10  Dim endRow_1 As Integer, endRow_2 As Integer
11  Dim wtRow As Integer, wtCol As Integer
12  Dim prdCD As String, psnName As String
13  Dim i As Integer
21  Sheets("Sheet1").Select
22  endRow_1 = Cells(Rows.Count, 1).End(xlUp).Row
23  endRow_2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
30  For i = 2 To endRow_1
40      prdCD = Cells(i, 1).Value '会社
41      psnName = Cells(i, 2).Value '社員
42      With Sheets("Sheet2")
50          Set c = .Range(.Cells(1, 1), .Cells(endRow_2, 1)).Find(prdCD) '会社検索
51          If Not c Is Nothing Then
52              wtRow = .Range(c.Address).Row
53              wtCol = .Cells(wtRow, Columns.Count).End(xlToLeft).Column + 1
54              .Cells(wtRow, wtCol).Value = psnName
60          Else
61              endRow_2 = endRow_2 + 1
62              .Cells(endRow_2, 1).Value = prdCD
63              .Cells(endRow_2, 2).Value = psnName
64          End If
70      End With
80  Next i
End Sub

ありがとうございました

一瞬で処理が終わりました。これから一つ一つのステートメントを解析していきます。ただただ驚きです。
VBAを勉強し始めですからよくわかりませんが、努力していきます。ありがとうございました。

その後、一つ一つのステートメントを確認しておりますが、VBAを勉強し始めた自分にとっては不可解な箇所が数カ所あります。それは、

22  endRow_1 = Cells(Rows.Count, 1).End(xlUp).Row
23  endRow_2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

50          Set c = .Range(.Cells(1, 1), .Cells(endRow_2, 1)).Find(prdCD) '会社検索
51          If Not c Is Nothing Then
52              wtRow = .Range(c.Address).Row
53              wtCol = .Cells(wtRow, Columns.Count).End(xlToLeft).Column + 1

などです。自分が目指している理想的なプロシージャーだと思いますが、できれば、もう2段階くらい初心者向きの比較的わかりやすいプロシージャがあれば今後の勉強になり、助かるのですが・・・・。
無理なのでしょうか？よろしくお願いします。

Ａnswer　　

2005.6.20　もてもて

22行目・・アクティブシート1列目の最終行
23行目・・ Sheet2の1列目の最終行
50行目・・ prdCDに会社が代入されています。Find(prdCD)で、prdCDのある場所を探しています。探す場所は、Sheet2の１列目なので、.Range(.Cells(1, 1), .Cells(endRow_2, 1)) と指定しています。 Set c = で、探した結果を、cに代入しています。
51行目・・検索結果がNothingで無ければ、
52行目・・書き込み行は、cに代入されてるアドレスの行
53行目・・上記行の最終列

「もう2段階くらい初心者向きの比較的わかりやすいプロシージャがあれば今後の勉強になり助かるのですが・・・・。」
理解し易いのは、検索する列をFor Nextで見るとか。 endRow_2に Sheet2の最終行が代入されているので、

    With Sheets("Sheet2")
        For i = 1 To endRow_2
            If .Cells(i, 1).Value = prdCD Then
                処理内容
            End If
        Next i
    End With

みたいな感じ。

本当にありがとうございました

ご丁寧に説明を加えていただき本当に感謝しております。ありがとうございました。
VBAの学習を始めたばかりなので、まだまだ全然わかりませんが、ひとつひとつのステートメントに無駄が全くないような感じがします。また的確な組み方をされているようでただただ感心しております。
もっともっと学習して少しでも近づきたいと思います。本当にありがとうございました。

http://www.geocities.jp/happy_ngi/