VGAを教えてください。

質問

sheet1のデータを下記のように自動で振り分けたいです。

sheet1（元データ）
A　　　　　　　B　　　　　　　　C　
拠点　　　　　担当者　　　　　金額
本店　　　　　田中　　　　　　　12,000
支店１　　　　山田　　　　　　　16,000
支店２　　　　鈴木　　　　　　　10,000
本店　　　　　田中　　　　　　　14,000
本店　　　　　下請A　　　　　　20,000
支店２　　　　下請B　　　　　　15,000

sheet2（拠点）
A　　　　　　　　　B　　　　　　　　　C
本店　　　　　　支店１　　　　　　支店2
12,000　　　　　16,000　　　　　10,000
14,000　　　　　　　　　　　　　　 15,000
20,000

sheet3（担当者（社員））
A　　　　　　　　　　　B　　　　　　　　　　C
田中 　　　　　 山田　　　　　　　鈴木
12,000　　　　　　16,000　　　　　　10,000
14,000

sheet4（担当者（下請））
A　　　　　　　　　　B　　　　　　　　C
下請A　　　　　　下請B
20,000　　　　　　15,000

担当者名は随時変わります。
宜しくお願いします。

回答No.3

watabe007

こんにちは、参考に
Sub Test()
Dim ws As Worksheet, ws1 As Worksheet
Dim c As Range
Dim myC As Variant

Set ws1 = Worksheets("Sheet1")
For Each ws In Worksheets(Array("Sheet2", "Sheet3", "Sheet4"))
'Sheet2～4の消去
ws.Cells.ClearContents
Next
For Each c In ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))
'拠点処理
With Worksheets("Sheet2")
myC = Application.Match(c.Value, .Rows(1), 0)
If IsError(myC) Then
myC = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
If .Cells(1, myC - 1).Value = "" Then myC = myC - 1
.Cells(1, myC).Value = c.Value
.Cells(2, myC).Value = c.Offset(, 2).Value
Else
.Cells(Rows.Count, myC).End(xlUp).Offset(1).Value = c.Offset(, 2).Value
End If
End With
'担当者処理
If Not c.Offset(, 1).Value Like "下請*" Then
With Worksheets("Sheet3")
'社員
myC = Application.Match(c.Offset(, 1).Value, .Rows(1), 0)
If IsError(myC) Then
myC = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
If .Cells(1, myC - 1).Value = "" Then myC = myC - 1
.Cells(1, myC).Value = c.Offset(, 1).Value
.Cells(2, myC).Value = c.Offset(, 2).Value
Else
.Cells(Rows.Count, myC).End(xlUp).Offset(1).Value = c.Offset(, 2).Value
End If
End With
Else
With Worksheets("Sheet4")
'下請
myC = Application.Match(c.Offset(, 1).Value, .Rows(1), 0)
If IsError(myC) Then
myC = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
If .Cells(1, myC - 1).Value = "" Then myC = myC - 1
.Cells(1, myC).Value = c.Offset(, 1).Value
.Cells(2, myC).Value = c.Offset(, 2).Value
Else
.Cells(Rows.Count, myC).End(xlUp).Offset(1).Value = c.Offset(, 2).Value
End If
End With
End If
Next
End Sub

回答No.2

某HN クロメート(Chromate)（@CoalTar）

VGAは640*480ドットの解像度ですね(^^;

データが下に追加されるとして、ピボットテーブルを考えてみました
社員か下請け化が分からないので、C列に分類を追加しました。
また、A列のデータは、空白にならないこととします

作業列 E2セルに =COUNTIF(A$2:A2,A2)
隣のF2セルまで右へオートフィル、下へオートフィル

[Ctrl]+[F3]名前の定義
名前 : PT_DATA
参照範囲
　=Sheet1!$A$1:INDEX(Sheet1!$F:$F,COUNTA(Sheet1!$A:$A))

データ - ピボットテーブルとグラフレポート
1/3 [次へ]
2/3 範囲:PT_DATA [次へ]
3/3 [レイアウト] ページ:分類、行:担当PT、列:担当者、データ:金額 [OK][完了]

拠点も同様です。総計は消すことが可能です。H列は非表示で良いでしょう。
ピボットテーブルツールバーから[更新]ボタンをクリックして、データの追加削除に対応できます。
ピボットテーブルのシートを表示させたときに、データを更新させるマクロを仕込んでおくと便利です。
添付図参照、参考まで

回答No.1

shintaro-2

>VGAを教えてください。

VGAではなくVBAね
Visual　Basic　for　Appli

>sheet1のデータを下記のように自動で振り分けたいです。

どこまで自動にしたいかだけど、
素直に、ピボットテーブルを３つつくるのが楽ではないですか？