Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12501 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【10261】キーの一致するデータを1行にまとめたい chii 04/1/14(水) 16:12 質問
【10270】Re:キーの一致するデータを1行にまとめたい INA 04/1/15(木) 9:08 回答
【10301】Re:キーの一致するデータを1行にまとめたい chii 04/1/16(金) 15:56 お礼
【10273】Re:キーの一致するデータを1行にまとめたい Jaka 04/1/15(木) 13:17 回答
【10276】Re:キーの一致するデータを1行にまとめたい ちん 04/1/15(木) 13:52 回答
【10303】Re:キーの一致するデータを1行にまとめたい chii 04/1/16(金) 17:10 質問
【10308】Re:キーの一致するデータを1行にまとめたい ちん 04/1/17(土) 9:57 発言
【10309】Re:キーの一致するデータを1行にまとめたい chii 04/1/17(土) 12:39 お礼
【10281】Re:キーの一致するデータを1行にまとめたい kein 04/1/15(木) 14:23 回答
【10287】Re:キーの一致するデータを1行にまとめたい chii 04/1/15(木) 21:57 お礼
【10261】キーの一致するデータを1行にまとめたい
質問  chii  - 04/1/14(水) 16:12 -
引用なし
パスワード
   初めまして。
（1）sheet1のＡ列をキーとし、キーの一致するデータを1行にまとめて
（2）sheet2の結果のようにしたいのですが、どのようにすれば
いいのでしょうか？ご教授ください。
よろしくお願いいたします。


（1）sheet1
　　　　Ａ列　　　　Ｂ列　　　　Ｃ列　　　　・・・・・30列
1　　　　ａ局　　　　1.2　　　　1号　　　　
2　　　　ａ局　　　　1.3　　　　3号　　　　
3　　　　ａ局　　　　1.8　　　　5号　　　　
4　　　　ｂ局　　　　3　　　　3号　　　　
5　　　　ｂ局　　　　1.3　　　　5号　　　　
6　　　　ｂ局　　　　5　　　　1号　　　　
7　　　　c局　　　　8.8　　　　1号　　　　
8　　　　c局　　　　1.3　　　　2号　　　　
9　　　　c局　　　　9.9　　　　1号　　　　
・　　　　　　　　　　　　　　　　
・　　　　　　　　　　　　　　　　
・


（2）sheet2
　　　　Ａ列　　　　Ｂ列　　　　Ｃ列　　　　D列　　　　E列　　　　F列　　　　G列・・・
1　　　　ａ局　　　　1.2　　　　1.3　　　　1.8　　　　1号　　　　3号　　　　5号　　　　
2　　　　ｂ局　　　　3　　　　1.3　　　　5　　　　3号　　　　5号　　　　1号　　　　
3　　　　c局　　　　8.8　　　　1.3　　　　9.9　　　　1号　　　　2号　　　　1号　　　　
・　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
・　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
・
【10270】Re:キーの一致するデータを1行にまとめた...
回答  INA  - 04/1/15(木) 9:08 -
引用なし
パスワード
   Ａ列はサンプルのように並び替えされた状態ですか？
あとデータの件数は、どれくらいありますか？

構想としては、
Ａ列をフィルタオプションの重複無視をして、キーを抽出してsheet2にコピーする。

sheet2　Ａ列をキーにsheet1をオートフィルタして、
抽出したＢ列をコピーして、sheet2に、行列入れ替えで貼り付け。
Ｃ列も同様。
このオートフィルタ＋コピペをFOR文でループ処理させれば出来ると思います。

ほとんどのコードはマクロの自動記録で出来ると思います。
【10273】Re:キーの一致するデータを1行にまとめた...
回答  Jaka  - 04/1/15(木) 13:17 -
引用なし
パスワード
   1行目にタイトルか空白行を挿入してください。データ部は２行目から
因みにSheet2には、B列2行目から書込んでいます。

Sub Macro1()
　　Dim Sh1 As Worksheet, Sh2 As Worksheet
　　Set Sh1 = Sheets("Sheet1")
　　Set Sh2 = Sheets("Sheet2")
　　lastR = Sh1.Range("A65536").End(xlUp).Row
　　For i = 2 To lastR
　　　　ShMc = Application.Match(Sh1.Cells(i, 1).Value, Sh2.Columns(2), 0)
　　　　If IsError(ShMc) = True Then
　　　　　 Sbst = Sh1.Cells(i, 1).Value
　　　　　 Sh2ER = Sh2.Range("B65536").End(xlUp).Row
　　　　　 Sh1.Range("A1:A" & lastR).AutoFilter Field:=1, Criteria1:=Sbst
　　　　　 Sh2.Cells(Sh2ER + 1, 2).Value = Sbst
　　　　　 For ii = 2 To 30　　'←Sheet1が30列って事で、まんま30のしました。
　　　　　　　　　　　　　　　 '使用状況にあった方法で、調べた方が良いかも。
　　　　　　　 Sh2EC = Sh2.Cells(Sh2ER + 1, 256).End(xlToLeft).Column
　　　　　　　 Sh1.Range(Sh1.Cells(2, ii), Sh1.Cells(lastR, ii)).Copy
　　　　　　　 Sh2.Cells(Sh2ER + 1, Sh2EC + 1).PasteSpecial Paste:=xlValues, Transpose:=True
　　　　　 Next
　　　　　 Sh1.AutoFilterMode = False
　　　　End If
　　Next
　　Set Sh1 = Nothing
　　Set Sh2 = Nothing
End Sub
【10276】Re:キーの一致するデータを1行にまとめた...
回答  ちん E-MAIL  - 04/1/15(木) 13:52 -
引用なし
パスワード
   ▼chii さん：
>初めまして。
>（1）sheet1のＡ列をキーとし、キーの一致するデータを1行にまとめて
>（2）sheet2の結果のようにしたいのですが、どのようにすれば
>いいのでしょうか？ご教授ください。
>よろしくお願いいたします。
>
>
ちんといいます。横から失礼します。
セルが空欄なら、処理終了の手法を取って、いけば汎用性があると思うので、
空欄なら、Exit ForでFor文をぬけるように作ってみました。

Dim i As Long
Dim Old_a1 As String　 '*** ＯＬＤキー
Dim A1_St1 As Long　　 '*** データ読み込み開始位置
Dim A1_Et1 As Long　　 '*** データ読み込み終了位置
Dim j As Integer, j1 As Integer, s1 As Integer, s2 As Integer
　　
Old_a1 = ""
s1 = 0　 '<--- Sheet2へのセットを開始する行
s2 = 0　 '<--- Sheet2へのセットを開始する列

For i = 1 To 65536
　If Sheet1.Cells(i, 1) = "" Then　'<-- 空欄ならデータ無しと判断する
　　Exit For
　End If
　If Old_a1 <> Sheet1.Cells(i, 1) Then
　　If Old_a1 = "" Then　'<-- 最初のみ
　　　A1_St1 = i　　　　 '<-- 同一データの開始位置をセット
　　　A1_Et1 = i　　　　 '<-- 同一データの終了位置をセット
　　　Old_a1 = Sheet1.Cells(i, 1)　'<--- キーの保存
　　Else
　　　A1_Et1 = i - 1　　 '<-- 同一データの終了位置をセット
　　　Old_a1 = Sheet1.Cells(i, 1)　'<--- キーの保存
　　　　
　　　GoSub Sheet2_SET　 '<--- シート２へデータセット
　　　A1_St1 = i　　　　 '<-- 同一データの開始位置をセット
　　　A1_Et1 = i　　　　 '<-- 同一データの終了位置をセット
　　End If
　End If
　　　　
Next i

'****　最後のデータをセットする。
If Old_a1 <> "" Then
　GoSub Sheet2_SET　 '<--- シート２へデータセット
End If
Exit Sub

Sheet2_SET:
'****　シート１のデータをシート２へデータセット
s1 = s1 + 1 '<--- Sheet2のデータセットする行
s2 = 0　　　'<--- Sheet2のデータセットする列
For j1 = 1 To 256　　'Ａ列〜ＩＶ列まで
　 If Sheet1.Cells(A1_St1, j1).Value = "" Then　'*** 空欄ならデータなし
　　 Exit For
　 End If
　 For j = A1_St1 To A1_Et1
　　 s2 = s2 + 1
　　 Sheet2.Cells(s1, s2).Value = Sheet1.Cells(j, j1).Value
　　 If s2 = 1 Then　　'*** Ａ列のデータは１回セットでおしまい。
　　　 Exit For
　　 End If
　 Next j
Next j1
Return

こんな感じでしょうか？参考までに・・・
【10281】Re:キーの一致するデータを1行にまとめた...
回答  kein  - 04/1/15(木) 14:23 -
引用なし
パスワード
   こんな感じで、どうでしょーか ?

Sub TestX()
　 Dim CkD As String
　 Dim i As Long, j As Long
　
　 j = 1
　 With Sheets("Sheet1")
　　　CkD = .Range("A1").Value
　　　.Rows(1).Copy Sheets("Sheet2").Range("A1")
　　　For i = 2 To .Cells(65536, 1).End(xlUp).Row
　　　　 If .Cells(i, 1).Value = CkD Then
　　　　　　.Range(.Cells(i, 2), .Cells(i, 256).End(xlToLeft)) _
　　　　　　.Copy Sheets("Sheet2").Cells(j, 256).End(xlToLeft) _
　　　　　　.Offset(, 1)
　　　　 Else
　　　　　　j = j + 1: CkD = .Cells(i, 1).Value
　　　　　　.Rows(i).Copy Sheets("Sheet2").Cells(j, 1)
　　　　 End If
　　　Next i
　 End With
End Sub
【10287】Re:キーの一致するデータを1行にまとめた...
お礼  chii  - 04/1/15(木) 21:57 -
引用なし
パスワード
   早速のレスありがとうございます。
INAさん、Jakaさん、ちんさん、keinさんご丁寧な回答をいただき、
とても感激しています。
ただ、ExcelVBAは始めたばかりで私の理解能力が足りず、
すべての検証をするのに時間がかかってしまいました。
そして後一歩のような気がするのですが、
どこをどう変えればいいのかわからない状況です。

もう少し頭の中を整理して、分からない部分を
質問したいと思っています。
こんな中途半端な状況でのお礼になってしまって大変
申し訳ありません。
【10301】Re:キーの一致するデータを1行にまとめた...
お礼  chii  - 04/1/16(金) 15:56 -
引用なし
パスワード
   ▼INA さん：
>Ａ列はサンプルのように並び替えされた状態ですか？
>あとデータの件数は、どれくらいありますか？

Ａ列は並び替えされた状態です。
データの件数は6000件程度です。

>構想としては、
>Ａ列をフィルタオプションの重複無視をして、キーを抽出してsheet2にコピーする。
>
>sheet2　Ａ列をキーにsheet1をオートフィルタして、
>抽出したＢ列をコピーして、sheet2に、行列入れ替えで貼り付け。
>Ｃ列も同様。
>このオートフィルタ＋コピペをFOR文でループ処理させれば出来ると思います。
>
>ほとんどのコードはマクロの自動記録で出来ると思います。

「FOR文でループ処理」の前までの記述については、できましたが
FOR文でループ処理を、今後勉強してみます。
ありがとうございました。
【10303】Re:キーの一致するデータを1行にまとめた...
質問  chii  - 04/1/16(金) 17:10 -
引用なし
パスワード
   ▼ちん さん：

回答をいただきありがとうございました。
みなさんの回答をじっくり検証してみたのですが、
今回やりたかった形がちんさんの方法で実現でき
そうなので、もう少し質問させてください。

ちんさんの方法で検証してみると、シート１の最終キーデータを
シート２へデータセットした時に、シート１の１行目だけしか
シート２へ書き込まれない状態です。
試しに、シート１最終行の後にダミーキーを入力して検証してみると
ダミーキーの前までは、正確に書き込まれています。
この方法でも、希望のものには達成したのですが、
もう少し勉強させてください。

最終キーに達した時に、最終キーの２行目３行目のデータ
もシート２へ書き込むようにするには、どこを変更したら
いいのでしょうか？
よろしくお願いします。
【10308】Re:キーの一致するデータを1行にまとめた...
発言  ちん E-MAIL  - 04/1/17(土) 9:57 -
引用なし
パスワード
   ▼chii さん：
>▼ちん さん：
>
>最終キーに達した時に、最終キーの２行目３行目のデータ
>もシート２へ書き込むようにするには、どこを変更したら
>いいのでしょうか？
>よろしくお願いします。
おはようございます。ちんといいます。
１行命令がぬけてました。すみません。
　　Next i
'****　最後のデータをセットする。
　　If Old_a1 <> "" Then
　　　A1_Et1 = i - 1　　 '<-- この行が欠落しておりました。
　　　GoSub Sheet2_SET　
　　End If
　　
　　Exit Sub

これで、大丈夫とおもいます。
【10309】Re:キーの一致するデータを1行にまとめた...
お礼  chii  - 04/1/17(土) 12:39 -
引用なし
パスワード
   ▼ちん さん：
>　　Next i
>'****　最後のデータをセットする。
>　　If Old_a1 <> "" Then
>　　　A1_Et1 = i - 1　　 '<-- この行が欠落しておりました。
>　　　GoSub Sheet2_SET　
>　　End If
>　　
>　　Exit Sub
>
>これで、大丈夫とおもいます。

回答ありがとうございました。
とてもすばらしいです。ばっちりできました。
こんなに親切に教えていただけるとは
思ってもみなかったので、すごく感動しました。

これから、もっとＶＢＡを勉強していこうと
思います。
本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12501 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free