以下のようなCSVデータがあります。
県名,品物名,購入者
青森,りんご,西田さん
青森,りんご,斉藤さん
青森,りんご,山田さん
愛媛,キウイ,島田さん
愛媛,みかん,石川さん
愛媛,みかん,佐藤さん
愛媛,みかん,田中さん
愛媛,みかん,小林さん
・
・
・
これを以下のように加工したいです。
県名,品物名,購入者1,購入者2,購入者3,購入者4・・・・・購入者100
青森,りんご,西田さん,斉藤さん,山田さん
愛媛,みかん,石川さん,佐藤さん,田中さん,小林さん
愛媛,キウイ,島田さん
・
・
・
要は、品物名でグループ化し、購入者の値を横並びにして項目名は連番にしたいです。
(項目名の連番は最後に手作業でも問題なし)
エクセルの手作業でならできましたが、品物名が500を超える場合があり、
購入者の数も100近くになるため、毎週こういうことはできないため、
エクセルやアクセスでなるべく簡単にできたらいいと思います。
スマートな方法のアイデアがあったらご教授ください。
No.5ベストアンサー
- 回答日時:
こんにちは!
VBAになってしまいますが、一例です。
Sheet1のデータをSheet2に表示するようにしてみました。
Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub Sample1() 'この行から
Dim i As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1") '←「Sheet1」は実際のSheet名に!
Set wS2 = Worksheets("Sheet2") '←「Sheet2」も実際のSheet名に!
Application.ScreenUpdating = False
wS2.Cells.ClearContents
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
wS1.Range("A1").Resize(, 2).Copy wS2.Range("A1")
wS1.Range("A:A").Insert
With Range(wS1.Cells(1, "A"), wS1.Cells(endRow, "A"))
.Formula = "=B1&C1"
.Value = .Value
.AdvancedFilter Action:=xlFilterInPlace, unique:=True
End With
endRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(2, "B"), wS1.Cells(endRow, "C")).Copy wS2.Cells(2, "A")
With wS1
.ShowAllData
.Range("A:A").Delete
End With
For i = 2 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
With wS1.Range("A1").CurrentRegion
.AutoFilter field:=1, Criteria1:=wS2.Cells(i, "A")
.AutoFilter field:=2, Criteria1:=wS2.Cells(i, "B")
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Cells(2, "C"), .Cells(endRow, "C")).Copy
wS2.Activate
ActiveSheet.Cells(i, "C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Next i
For i = 3 To wS2.UsedRange.Columns.Count
wS2.Cells(1, i) = wS1.Cells(1, "C") & i - 2
Next i
Application.ScreenUpdating = True
wS1.AutoFilterMode = False
End Sub 'この行まで
こんなんではどうでしょうか?m(_ _)m
ありがとうございます。
このソースのまま実現できてしまいました。
でもこんな見も知らず人の質問に、こうもパッとソースを書けてしまうスキルに感服です。
回答者さんにとってはそんな簡単な事なんでしょうか?
実は後から、C列に「種別」という項目が追加されてしまい(値は、野菜、果物等)、
購入者の列がD列に移動してしまいました。
ソースを手直ししてD列が横並びになるようにカスタマイズできましたが、
項目名と値が、
県名,品物名,購入者1,購入者2・・・
青森,りんご,果物,西田さん,斉藤さん
のように1列ずれてしまいました。
本当は
県名,品物名,種別,購入者1,購入者2・・・
青森,りんご,果物,西田さん,斉藤さん
としたいのですが・・・
それを解析するのが今後の課題です。
(教えてもらえると嬉しいです。)
No.8
- 回答日時:
No.5・6です。
No.5に
>「シート変換ボタン」というシートを作りそこにマクロ実行ボタンを置けたので、
というコトですが、
前回のコードは標準モジュールにして、
「マクロ実行ボタン」(←おそらくコマンドボタンだと思います)のコードを
Private Sub CommandButton1_Click()
Call Sample2
End Sub
としてみてもダメでしょうか?
※ Sample2 は前回のマクロ名ですので、
マクロ名を変えている場合はご自身でつけられたマクロ名にします。m(_ _)m
はい。コマンドボタンのことです。
最初に教えていただいたマクロを加工して、何とか都合の良いものにすることができました。
ありがとうございます!
No.7
- 回答日時:
別の質問に触発されて、自ブックに対するADOでの抽出をやってみました。
xl2003以前については、自ブックに対して適用するとメモリリークが発生するというバグが放置されていて使えません。勤務先もそろそろxl2007以降のフォーマットが標準になりそうなので、復習してみました。フィールド名決め打ちならもっとシンプルなコードになりますが、極力汎用化しようとトライしてみました。
後出しなので、「種別」にも対応しています。
なお、この方法ならアレンジすればCSVから直にできるかもしれませんが、上記の理由でSheet1に読み込んでからの処理です。
Const adOpenFowardOnly As Long = 0
Sub test()
Dim cn As Object
Dim rs0 As Object, rs As Object, rs2 As Object
Dim mySQL As String, mySQL2 As String
Dim destRange As Range
Dim i As Long, j As Long
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ace.OLEDB.12.0"
.connectionstring = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0; HDR=YES'"
.Open
End With
'rs0 フィールド名取得用
Set rs0 = CreateObject("ADODB.Recordset")
rs0.Open "SELECT * FROM [Sheet1$];", cn, adOpenFowardOnly
'rs グループ化したRecordset
Set rs = CreateObject("ADODB.Recordset")
mySQL = "SELECT F1,F2,F3 FROM [Sheet1$] GROUP BY F1,F2,F3;"
For i = 1 To 3
mySQL = Replace(mySQL, "F" & CStr(i), rs0.Fields(i - 1).Name)
Next i
rs.Open mySQL, cn, adOpenFowardOnly
Sheets("Sheet2").Cells.Clear
Set destRange = Sheets("Sheet2").Range("A2")
For i = 1 To 3
destRange.Offset(, i - 1).Item(0) = rs0.Fields(i - 1).Name
Next i
For i = 1 To 100
destRange.Offset(, 2 + i).Item(0) = rs0.Fields(3).Name & CStr(i)
Next i
Do Until rs.EOF
For i = 0 To 2
destRange.Offset(, i).Value = rs.Fields(i).Value
Next i
mySQL2 = "SELECT F4 FROM [Sheet1$] WHERE F1='F1Value' AND F2 = 'F2Value' AND F3 = 'F3Value';"
For i = 1 To 4
If i < 4 Then mySQL2 = Replace(mySQL2, "F" & CStr(i) & "Value", rs.Fields(i - 1).Value)
mySQL2 = Replace(mySQL2, "F" & CStr(i), rs0.Fields(i - 1).Name)
Next i
'rs2 グループ化した組み合わせ毎に該当するリストを取得
Set rs2 = CreateObject("ADODB.Recordset")
rs2.Open mySQL2, cn, adOpenFowardOnly
j = 3
Do Until rs2.EOF
destRange.Offset(, j).Value = rs2.Fields(0).Value
rs2.MoveNext
j = j + 1
Loop
Set rs2 = Nothing
rs.MoveNext
Set destRange = destRange.Offset(1, 0)
Loop
Set rs0 = Nothing
Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub
ありがとうございます。
しかし実行すると「nullの使い方が不正です。」というエラーが出てしまい、
以下の行が黄色いマーカーになりました。
mySQL2 = Replace(mySQL2, "F" & CStr(i) & "Value", rs.Fields(i - 1).Value)
No.6
- 回答日時:
No。
5です。>本当は
>県名,品物名,種別,購入者1,購入者2・・・
というコトはSheet1が↓の画像のような配置になっているという前提です。
前回は時間がなかったので慌ててコードを作ってしまいました。
前回とはちょっと違いますが、↓のコードでマクロを試してみてください。
Sub Sample2()
Dim i As Long, j As Long, endRow As Long, lastRow As Long, endCol As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS2.Cells.ClearContents
With wS1
.Range("A1").Resize(, 3).Copy wS2.Range("A1")
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").Insert
With .Range("A1").Resize(endRow)
.Formula = "=B1&C1"
.Value = .Value
End With
.Range(Cells(1, "A"), Cells(endRow, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range(Cells(2, "B"), Cells(lastRow, "D")).Copy wS2.Cells(2, "A")
.ShowAllData
.Range("A:A").Delete
For i = 2 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").AutoFilter field:=1, Criteria1:=wS2.Cells(i, "A")
.Range("A1").AutoFilter field:=2, Criteria1:=wS2.Cells(i, "B")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Cells(2, "D"), .Cells(lastRow, "D")).Copy
wS2.Activate
ActiveSheet.Cells(i, "D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
endCol = wS2.UsedRange.Columns.Count
For j = 4 To endCol
wS2.Cells(1, j) = .Range("D1") & j - 3
Next j
End With
wS1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
今度はどうでしょうか?m(_ _)m
ありがとうございます。
問題点が解決されていて完ぺきでした!
ただ一つ残念なのが、
sheet1をアクティブにした状態でマクロを実行しないとエラーになってしまう点です。
前回の場合は、別のシートがアクティブになっていても、
sheet1を加工してsheet2に書き出してくれていたので、
「シート変換ボタン」というシートを作りそこにマクロ実行ボタンを置けたので、
開発タブを出していないユーザでも実行できるようにできていました。
自分でソースが読めるようになりたいです。
No.4
- 回答日時:
(1)CSVファイル(仮にtest.csvとする)を、Excelで開く。
D2→ =A2&B2、 E2→ =COUNTIF($D$2:D2,D2)、 F2→ =D2&E2
を入力し、必要なだけ下へコピー。
(2)以下のような数式の入ったBook1(予め作成しておくと便利)を開く
・1行目は、予め入力
A2→ =IF(test.csv!$E2=1,test.csv!A2,"")
B2→ =IF(test.csv!$E2=1,test.csv!B2,"")
必要なだけ下へコピー。
C2→ =IFERROR(OFFSET(test.csv!$F$1,MATCH($A2&$B2&COLUMN()-2,test.csv!$F$2:$F$9,0),-3),"")
必要なだけ、右方向・下方向へコピー。
(3)並べ替え等で、空白行を詰める
※バージョンによっては、IFERRORは使えないかもしれません。
No.3
- 回答日時:
[No.2]に示した配列数式は間違いではないけど、少し冗長な箇処がありました。
「Sheet1!」を2箇処削除した次式でもOKです。
{=INDEX(Sheet1!$C$1:$C$50000,SMALL(IF((Sheet1!$A$1:$A$50000=$A2)*(Sheet1!$B$1:$B$50000=$B2),(Sheet1!$A$1:$A$50000=$A2)*(Sheet1!$B$1:$B$50000=$B2)*ROW(A$1:A$50000),""),COLUMN(A1)))}
私の回答が難解過ぎる場合は無視して下さい。補足説明するのが面倒なので。
No.2
- 回答日時:
数式が =ISERROR(C2)
フォント色 白
の[条件付き書式]を設定した Sheet2 のセル C2 に次の配列数式を入力し、此れをズズーッと右および下方にドラッグ&ペースト
{=INDEX(Sheet1!$C$1:$C$50000,SMALL(IF((Sheet1!$A$1:$A$50000=$A2)*(Sheet1!$B$1:$B$50000=$B2),(Sheet1!$A$1:$A$50000=$A2)*(Sheet1!$B$1:$B$50000=$B2)*ROW(Sheet1!A$1:A$50000),""),COLUMN(Sheet1!A1)))}
なお、Sheet2 の列A、Bのデータは、例えば次のような方法で、事前に作成しておく。
先ず、ピボットテーブルを利用すれば、Fig-1 のデータが簡単に作成できる。
それを Fig-2 のように加工するのも簡単!
ありがとうございます。
関数を使いこなす方法ですね。
解析して応用できるようにします。
今回はマクロで簡単に済ます方法にします。
No.1
- 回答日時:
とりあえず省力化できる方法を考えてみました。
(1)A2,B2,C2から縦にデータを入力する。A2="青森",B2="りんご",C2="西田さん"という具合。
(2)D2に、
=IF(A1&B1=A2&B2,D1&","&C2,C2)
という数式を入れて、縦方向にコピーする。(列Cにデータの存在する行すべて)
(3)E2に
=IF(A2&B2<>A3&B3,D2,"")
という数式を入れて、縦方向にコピーする。(列Cにデータの存在する行すべて)
(4)列A-Eのデータをコピーし、別のシートに
形式を選択して貼り付け->値
を使って、値として貼り付ける。
(5)貼りつけたのがA1からとして、列A-Eを列E基準で並べ替える。
(6)列Eにデータがあるものだけがまとまっているので、それ以外の行を削除する。
(7)列Dを削除する。
(8)列Dを選択して、
区切り位置->カンマ区切り
でデータを分割する。
(9)列Cを削除する。
品物名が同じでも県名が違うものは別に集計するようになっていますので、品物名だけで
いい場合は計算式を変更してください。
ありがとうございます。
マクロとか特殊な方法を使わずとも、手順を追っていけばできる堅実な方法ですね。
参考にさせていただきました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
複数のCSVファイルを横に並べてひとつのエクセルファイルへ結合する方法
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの警告について
-
タイムスタンプとテキストから...
-
シートの情報を別のシートへま...
-
マクロの処理が遅くなった
-
Excelでの文字色
-
ワークシートに出現したこの画...
-
EXCELの散布図で日付が1900年に...
-
OFFSET関数を使用したいのです...
-
エクセルでファイルの最終更新...
-
エクセルの文字が途中から消える
-
エクセルデーターから必要な項...
-
Excel 大小比較演算子による「...
-
SUBTOTALは、参照された数字で...
-
エクセルの数式バーのフォント...
-
エクセルの「条件付き書式」を...
-
Excelについて教えてください。...
-
エクセルVBA 月の中で、月~土...
-
Excelの数字の前に入っている空...
-
Excelの関数について このよう...
-
セルの数を求めたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの警告について
-
Excelで数値を時間数に変換する...
-
エクセルの数式バーのフォント...
-
エクセルで数字の組み合わせを...
-
エクセルを使用して、円周率を...
-
Excelで特定の文字列が含まれて...
-
Excel 対象のセルに入力が無い...
-
任意の値が存在する行に名前を...
-
エクセルでファイルの最終更新...
-
index関数の説明をお願いします。
-
条件付き書式でやりたいのですが
-
重複しない値を取り出したい
-
【ExcelVBA】UTF-8(BOM無)でC...
-
【マクロ】マクロが割当てされ...
-
エクセル IF計算式?でしょうか?
-
エクセルで曜日を入れたい
-
表中の指定した条件の文字列を...
-
【Excel】版が同じ事を示す番号...
-
EXCELの散布図で日付が1900年に...
-
Excelについて。Excelに縦1列に...
おすすめ情報