Excel VBA質問箱 IV

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

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


12481 / 13645 ツリー ←次へ | 前へ→

【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のA列をキーとし、キーの一致するデータを1行にまとめて
(2)sheet2の結果のようにしたいのですが、どのようにすれば
いいのでしょうか?ご教授ください。
よろしくお願いいたします。


(1)sheet1
    A列    B列    C列    ・・・・・30列
1    a局    1.2    1号    
2    a局    1.3    3号    
3    a局    1.8    5号    
4    b局    3    3号    
5    b局    1.3    5号    
6    b局    5    1号    
7    c局    8.8    1号    
8    c局    1.3    2号    
9    c局    9.9    1号    
・                
・                



(2)sheet2
    A列    B列    C列    D列    E列    F列    G列・・・
1    a局    1.2    1.3    1.8    1号    3号    5号    
2    b局    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 -

引用なし
パスワード
   A列はサンプルのように並び替えされた状態ですか?
あとデータの件数は、どれくらいありますか?

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

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

ほとんどのコードはマクロの自動記録で出来ると思います。

【10273】Re:キーの一致するデータを1行にまとめた...
回答  Jaka  - 04/1/15(木) 13:17 -

引用なし
パスワード
   1行目にタイトルか空白行を挿入してください。データ部は2行目から
因みに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のA列をキーとし、キーの一致するデータを1行にまとめて
>(2)sheet2の結果のようにしたいのですが、どのようにすれば
>いいのでしょうか?ご教授ください。
>よろしくお願いいたします。
>
>
ちんといいます。横から失礼します。
セルが空欄なら、処理終了の手法を取って、いけば汎用性があると思うので、
空欄なら、Exit ForでFor文をぬけるように作ってみました。

Dim i As Long
Dim Old_a1 As String  '*** OLDキー
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  '<--- シート2へデータセット
   A1_St1 = i     '<-- 同一データの開始位置をセット
   A1_Et1 = i     '<-- 同一データの終了位置をセット
  End If
 End If
    
Next i

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

Sheet2_SET:
'**** シート1のデータをシート2へデータセット
s1 = s1 + 1 '<--- Sheet2のデータセットする行
s2 = 0   '<--- Sheet2のデータセットする列
For j1 = 1 To 256  'A列〜IV列まで
  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  '*** A列のデータは1回セットでおしまい。
    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 さん:
>A列はサンプルのように並び替えされた状態ですか?
>あとデータの件数は、どれくらいありますか?

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

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

「FOR文でループ処理」の前までの記述については、できましたが
FOR文でループ処理を、今後勉強してみます。
ありがとうございました。

【10303】Re:キーの一致するデータを1行にまとめた...
質問  chii  - 04/1/16(金) 17:10 -

引用なし
パスワード
   ▼ちん さん:

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

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

最終キーに達した時に、最終キーの2行目3行目のデータ
もシート2へ書き込むようにするには、どこを変更したら
いいのでしょうか?
よろしくお願いします。

【10308】Re:キーの一致するデータを1行にまとめた...
発言  ちん E-MAIL  - 04/1/17(土) 9:57 -

引用なし
パスワード
   ▼chii さん:
>▼ちん さん:
>
>最終キーに達した時に、最終キーの2行目3行目のデータ
>もシート2へ書き込むようにするには、どこを変更したら
>いいのでしょうか?
>よろしくお願いします。
おはようございます。ちんといいます。
1行命令がぬけてました。すみません。
  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
>
>これで、大丈夫とおもいます。

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

これから、もっとVBAを勉強していこうと
思います。
本当にありがとうございました。

12481 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free