Aの表をBの形に並び替え出来る方法を教えて下さい!
A
地方店商品数量1月
愛知A店りんご10
愛知A店バナナ20
岐阜A店みかん15
岐阜B店バナナ15
三重B店りんご20
三重C店バナナ25
三重C店みかん20
地方店商品数量2月
愛知B店バナナ15
愛知C店みかん20
岐阜A店みかん20
三重A店りんご30
三重B店りんご10
三重B店バナナ40
↓
B
地方商品数量1月数量2月店
愛知りんご 10 A店
三重 20 B店
三重 30 A店
三重 10 B店
愛知バナナ 20 A店
愛知 15 B店
岐阜 15 B店
三重 25 C店
三重 40 B店
愛知みかん 20 C店
岐阜 15 A店
岐阜 20A店
三重 20 C店
KURUNA
No.1ベストアンサー
- 回答日時:
こんにちは!
VBAになりますが、一例です。
元データはSheet1(↓の画像の左側)にあり、右側のSheet2に表示するとします。
Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)マクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub Sample1() 'この行から
Dim i As Long, k As Long, lastRow1 As Long, lastRow3 As Long, myRow As Long, lastCol As Long
Dim str As String, c As Range, r As Range, wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS2.Cells.Clear
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wS3 = Worksheets(Worksheets.Count)
With Worksheets("Sheet1")
lastRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
wS2.Range("B1") = .Range("A1")
wS2.Range("C1") = .Range("C1")
.Range("A:A").Insert
.Range("A1") = "ダミー"
For i = 1 To lastRow1
If Not IsNumeric(.Cells(i, "E")) Then
str = .Cells(i, "E")
Else
.Cells(i, "A") = str
End If
Next i
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True
.Range("D:D").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("B1"), unique:=True
wS3.Range("B1") = "ダミー"
wS3.Range("B:B").Replace what:="商品", replacement:="", lookat:=xlWhole
wS3.Range("A:B").SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
lastRow3 = wS3.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow3, "A")).Copy
wS2.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
lastCol = wS2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
wS2.Cells(1, lastCol) = .Range("C1")
For i = 2 To wS3.Cells(Rows.Count, "B").End(xlUp).Row
.Range("A1").AutoFilter field:=4, Criteria1:=wS3.Cells(i, "B")
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow1, "E")).SpecialCells(xlCellTypeVisible).Copy _
wS3.Range("C1")
For k = 1 To wS3.Cells(Rows.Count, "C").End(xlUp).Row
Set c = wS2.Range("A:A").Find(what:=wS3.Cells(k, "C") & wS3.Cells(k, "D") & _
wS3.Cells(k, "E") & wS3.Cells(k, "F"), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
myRow = wS2.UsedRange.Rows.Count + 1
wS2.Cells(myRow, "A") = wS3.Cells(k, "C") & wS3.Cells(k, "D") & wS3.Cells(k, "E") & wS3.Cells(k, "F")
Else
myRow = c.Row
End If
Set r = wS2.Rows(1).Find(what:=wS3.Cells(k, "C"), LookIn:=xlValues, lookat:=xlWhole)
wS2.Cells(myRow, "B") = wS3.Cells(k, "D")
wS2.Cells(myRow, "C") = wS3.Cells(k, "F")
wS2.Cells(myRow, r.Column) = wS3.Cells(k, "G")
wS2.Cells(myRow, lastCol) = wS3.Cells(k, "E")
Next k
wS3.Range("C:G").Clear
End If
Next i
.AutoFilterMode = False
.Range("A:A").Delete
wS2.Range("A:A").Delete
Application.DisplayAlerts = False
wS3.Delete
Application.ScreenUpdating = True
wS2.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
wS2.Columns.AutoFit
wS2.Activate
wS2.Range("A1").Select
For i = wS2.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If wS2.Cells(i, "B") = wS2.Cells(i - 1, "B") Then
wS2.Cells(i, "B").ClearContents
End If
Next i
End With
Application.ScreenUpdating = True
End Sub 'この行まで
※ 関数でないので、データ変更があるたびにマクロを実行する必要があります。m(_ _)m
tom04様へ
ご丁寧な回答有難うございます。
とてもレベルの高い回答ですね!
作業後の表も完璧デス1
こんな私に出来るでしょうか?
1度トライしてみます!
どうも有難うございました♪
KURUNA
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 社会学 愛知岐阜三重(静岡)という括りより 3 2022/04/20 22:49
- 東海 三重県と岐阜県 東海三県と東三河 4 2022/09/02 16:06
- 事件・犯罪 盗難された自転車。県境を越えると逮捕されない? 1 2022/06/20 20:42
- テレビ 春に自宅のテレビをケーブルテレビから地デジにしましたが、大広間にある大きなテレビと、和室にある小さな 6 2023/08/22 20:56
- 大学受験 愛知県に住んでます。名古屋工業大学か三重大学、岐阜大学どれか1番マシですか?工学部です。 就職は名工 6 2022/07/21 17:52
- 東海 ドラクエウォーク:黄金の信長像、犬山城、豊田スタジアム 1 2022/12/28 20:52
- アニメ 愛知県以西のアニメ聖地 1 2023/07/12 14:54
- 東海 なんで岐阜県の高校生ライダーすくないの? 隣の愛知は沢山いるのに 1 2022/08/01 19:55
- 転職 正規の教員を辞め、他県の講師になると給与はどれほどさがるか。 岐阜に勤めて9年。現在30歳。愛知の彼 2 2022/08/14 02:27
- レディース NIKEエアマックスのスニーカーが欲しいんですが、エアマックスがたくさん置いてあるお店どこにあります 1 2023/03/24 14:36
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
バナナがすごく柔らかくなって...
-
エクセルVBAのIF文の否定の複数...
-
野生のサルは、バナナを皮ごと...
-
コバエはバナナの皮から生まれ...
-
昔のアイスで ダブルバナナって...
-
バナナの芯について
-
バナナの皮が自然に剥けますが...
-
バナナを長持ちさせる方法!
-
真っ黒になったバナナが半額ぐ...
-
バナナチップスの作り方
-
「と比べると」と「に比べると」
-
熟しすぎたバナナでレシピ
-
会話が終わりかけていたときのL...
-
Access 2002で既定値に入力した...
-
エクセル2010で表の複数の...
-
バナナベースのホットサンドに...
-
バナナを熟さずに持ち運ぶ方法...
-
バナナを ショウジョウバエから...
-
冷凍庫からバナナを出して、冷...
-
バナナって栄養的にどうなの?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
バナナがすごく柔らかくなって...
-
エクセルVBAのIF文の否定の複数...
-
コバエはバナナの皮から生まれ...
-
野生のサルは、バナナを皮ごと...
-
バナナを長持ちさせる方法!
-
バナナの中心に穴?
-
両手で握って亀頭が出てるのは...
-
三文字で母音が全て『あ』の食...
-
「と比べると」と「に比べると」
-
バナナの芯について
-
冷凍庫からバナナを出して、冷...
-
バナナの皮が自然に剥けますが...
-
今思いつきましたが、バナナを...
-
途切れることなく、一本の巨大...
-
昔のアイスで ダブルバナナって...
-
この間、バナナを食べようと皮...
-
黄色いのにかたい バナナ
-
会話が終わりかけていたときのL...
-
バナナって洗いますか?
-
熟して柔らかくなったバナナの...
おすすめ情報