
Sheet1には以下のデータが入力されています。
NO TIMES SCORE
1 1 20
1 2 30
1 3 25
2 1 50
2 2 40
2 3 45
3 1 70
3 2 75
4 3 3
いっぽうsheet2には以下のデータが入力されています。
NO NAME SEX AGE
1 Aさん 男 31
2 Bさん 女 27
3 Cさん 女 33
4 Dさん 男 26
この2つのデータをNOをキーとして横に結合したいのですが
VBAでこのような結合操作はできるものでしょうか?
NO NAME SEX AGE TIMES SCORE
1 Aさん 男 31 1 20
1 Aさん 男 31 2 30
1 Aさん 男 31 3 25
2 Bさん 女 27 1 50
2 Bさん 女 27 2 40
2 Bさん 女 27 3 45
3 Cさん 女 33 1 70
3 Cさん 女 33 2 75
4 Dさん 男 26 3 3
if文を使ってNOが1ならNAMEがAさん、SEXが男・・・という
条件文をかけばできないこともありませんが、
実際のデータではNOが450もありますので
非効率と考えています。
もしご存知でしたら教えていただけませんか。
よろしくお願いいたします。
No.3ベストアンサー
- 回答日時:
シート1の横にシート2の情報を貼り付ける方法です。
質問に提示された列の並びと異なりますが、結合と言う意味では
要件を満たしていると思います。
シート2は見出しを含め451行あると仮定します。
Sub Sample()
Dim SH1 As Range
Dim SH2 As Range
Dim i As Long
Set SH1 = Sheets("Sheet1").Range("a1").CurrentRegion
Set SH2 = Sheets("Sheet2").Range("a1:d451")
For i = 2 To SH1.Rows.Count
SH1.Cells(i, 4) = Application.VLookup(SH1.Cells(i, 1), SH2, 2, 0)
SH1.Cells(i, 5) = Application.VLookup(SH1.Cells(i, 1), SH2, 3, 0)
SH1.Cells(i, 6) = Application.VLookup(SH1.Cells(i, 1), SH2, 4, 0)
Next i
Set SH1 = Nothing
Set SH2 = Nothing
End Sub
以上です。
ありがとうございます。
コンパクトで分かりやすいですね。
SETというものを知らなかったので、大変勉強になりました。
ありがとうございます。
自分でもコードを1からなぞって勉強させていただきます。
ところでコード中にa1:d451ってありますが、この451を
SH1.Rows.COUNTに置き換えることってできるのでしょうか?
No.5
- 回答日時:
#3です。
>ところでコード中にa1:d451ってありますが、この451を
>SH1.Rows.COUNTに置き換えることってできるのでしょうか?
シート1とシート2では行数が異なると思いますので、出来ません。
汎用性と言う意味ではRange("a1:d451")の代わりにRange("a1").CurrentRegion
とした方が良いかもしれません。
No.4
- 回答日時:
VBAを持ち出さずとも、VLOOKUPで十分ではないかと思いましたが、VBAで式を、動的な対象範囲に対して生成するのはどうやるのかなと、気になったのでやってみました。
#3と考え方は似ているかもしれません。ご参考まで...とは言い難いですが。'Sheet1,Sheet2のデータを照合して、Sheet3にまとめる
Sub test()
Dim destRange As Range
Dim i As Long
Dim master As Range
Dim fieldNames As Range
Sheets("Sheet1").Cells.Copy Sheets("Sheet3").Range("a1")
Set master = Sheets("Sheet2").Range("a1").CurrentRegion
Set fieldNames = master.Rows(1)
Set master = master.Offset(1, 0).Resize(master.Rows.Count - 1, master.Columns.Count)
Set destRange = Sheets("Sheet3").Range("a1").CurrentRegion
Set destRange = destRange.Offset(1, 0).Resize(destRange.Rows.Count - 1, destRange.Columns.Count)
For i = 2 To 4
destRange.Columns(i).EntireColumn.Insert Shift:=xlToRight
destRange.Columns(i).FormulaR1C1 = "=VLOOKUP(RC1,Sheet2!" & master.Address(True, True, xlR1C1) & "," & Format(i, "0") & ",false)"
Next i
fieldNames.Copy Sheets("Sheet3").Range("a1")
End Sub
関数入力を自動記録すると、R1C1形式で記述される事を知りました。
ありがとうございます。
今まではvlookupでやっていたのですが、ここひと月前から
VBAを勉強中でして、実際に今までやってきた業務を
VBAでできるかチャレンジしていたのでした。
いやいやみなさん、スラスラとお書きになられるようで
すばらしいです。
いただいたコードを勉強します!
No.1
- 回答日時:
Sheet2にはNoの重複がないものとして、結果をSheet3に書き出します。
Sub test()
Dim Dic As Object
Dim i As Long, j As Long
Dim m As Long, n As Long
Dim v, w, x
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet2")
v = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp).Resize(, 4)).Value
End With
ReDim x(1 To 6, 1 To 1): m = 1
For i = 1 To UBound(v, 1)
Dic.Add v(i, 1), Array(v(i, 2), v(i, 3), v(i, 4))
Next
With Worksheets("Sheet1")
w = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp).Resize(, 3)).Value
For j = 1 To UBound(w, 1)
If Dic.exists(w(j, 1)) Then
x(1, m) = w(j, 1): x(2, m) = Dic(w(j, 1))(0)
x(3, m) = Dic(w(j, 1))(1): x(4, m) = Dic(w(j, 1))(2)
x(5, m) = w(j, 2): x(6, m) = w(j, 3)
m = m + 1
ReDim Preserve x(1 To 6, 1 To m)
End If
Next
End With
With Worksheets("Sheet3")
.Range("A1:F1").Value = Array("NO", "NAME", "SEX", "AGE", "TIMES", "SCORE")
.Range("A2").Resize(m - 1, 6).Value = Application.Transpose(x)
End With
Set Dic = Nothing
Erase v, w, x
End Sub
ご参考になれば。
ありがとうございます。
非常にエレガントなコードですね。
コードを見せていただきましたが、知らない構文がいろいろと
あるので、いい勉強材料をいただいたと感謝しております。
やはり本よりも人が書いたコードのほうが勉強になりますね。
私もあなたのようにスラスラとコードが書けるように
がんばっていきたいです。
今後ともよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAで、1つのエクセルで、2つのシートからもう1つのシートに条件のある転記コードを教えてください。 1 2023/03/16 18:07
- その他(プログラミング・Web制作) Pythonで会員サイトの自動ログイン ID Nameがない 1 2022/12/16 02:09
- Excel(エクセル) VBAで、シート間の転記するコードを教えてください。 4 2023/03/26 10:43
- C言語・C++・C# C言語 プログラミング 4 2022/05/22 11:53
- PHP phpでこの記述をもっと簡単に書く方法はないでしょうか…? 3 2022/11/16 19:57
- その他(ニュース・時事問題) 「男女の脳に有意な差はない」との説が登場。男女のそれぞれの良いところを活かそう論はどうなる? 3 2022/07/08 19:45
- MySQL 【MySQL】本当に困っているので、助けてください。よろしくお願いします。 3 2023/06/03 14:24
- Visual Basic(VBA) VBAで大量データの処理 3 2022/11/15 21:53
- PHP コメント機能に返信欄を矢印で追加したい 1 2022/05/09 21:17
- Visual Basic(VBA) 【VBA】データを入力後に,同一シート内に履歴として転記するVBAコードを教えていただきたいです。 3 2022/11/16 01:37
このQ&Aを見た人はこんなQ&Aも見ています
-
今年はじめたいことは?
今年はこれをはじめたい!ということを教えてください!
-
人生最悪の忘れ物
今までの人生での「最悪の忘れ物」を教えてください。 私の「最悪の忘れ物」は「財布」です。
-
モテ期を経験した方いらっしゃいますか?
一生に一度はモテ期があるといいますが、みなさんどうですか? いまがそう! という方も、「思い返せばこの頃だったなぁ」という方も、よかったら教えて下さい。
-
あなたなりのストレス発散方法を教えてください!
自分なりのストレス発散方法はありますか?
-
集中するためにやっていること
家で仕事をしているのですが、布団をはじめ誘惑だらけでなかなか集中できません。
-
EXCEL VBAで複数シートから該当列のみを別シート列方向に順番に貼り付け
Visual Basic(VBA)
-
複数のCSVファイルを横に並べてひとつのエクセルファイルへ結合する方法
Excel(エクセル)
-
複数csvを横に追加していくマクロについて
Visual Basic(VBA)
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
男性が好きな人でオナニーする...
-
男性に質問:彼女をオカズにし...
-
生とゴムの違い
-
処女を抱いた男性へ質問です
-
処女とエッチして 相手の男性が...
-
昨日の晩にスゴくいやらしい体...
-
息子と性的関係になり抜け出せない
-
エロくなってきた妻
-
付き合えそうな女性との行為…想...
-
男性は好きな女性なら挿入行為...
-
28才OLです、マスターベー...
-
男の人が勃ってるときって、頭...
-
入れられてる側は(女性側)どん...
-
セフレの女性が離れていきそうな時
-
男性に質問!女の人がイク時っ...
-
処女のとき、何回目のHで挿入...
-
職場の女性社員を見て妄想する...
-
ぶっちゃけすぐ濡れる女の子っ...
-
男性は前戯だけでも我慢できる...
-
彼女の喘ぎ声って可愛いものな...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
女性はマンコ舐めてほしいんで...
-
男性に質問:彼女をオカズにし...
-
生とゴムの違い
-
昨日の晩にスゴくいやらしい体...
-
息子と性的関係になり抜け出せない
-
エロくなってきた妻
-
処女とエッチして 相手の男性が...
-
28才OLです、マスターベー...
-
付き合えそうな女性との行為…想...
-
処女を抱いた男性へ質問です
-
男性側はセックスでの挿入時、...
-
男性は好きな女性なら挿入行為...
-
入れられてる側は(女性側)どん...
-
男の人が勃ってるときって、頭...
-
セフレの女性が離れていきそうな時
-
処女のとき、何回目のHで挿入...
-
職場の女性社員を見て妄想する...
-
男性に質問!女の人がイク時っ...
-
男性は前戯だけでも我慢できる...
-
イっちゃった時って男の人って...
おすすめ情報