Excel VBA質問箱 IV

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

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


4632 / 76734 ←次へ | 前へ→

【77720】縦並びを横並びにしたいです。
質問  さと  - 15/12/6(日) 12:50 -

引用なし
パスワード
   はじめて投稿させていただきます。
仕事で、縦並びの表を横並びにする必要があり、VBAで対応したく思っております。
条件としてA列(コード)に従い、予めE列(作業列)に表示してあるコードの右側に氏名と金額を横並びにしたいのですが、その際、A列のコードが同じものはE列に記載してあるコードの更に右側に(氏名)と(金額)を加えていくというものです。

(表)
A    B    C   D  E     F    G    H     I    J    K
コード 氏名  金額   作業列  1    2    3     4    5    6
1001  ホンダ 3500   1001  ホンダ 3500           
1002  スズキ 5000   1002  スズキ 5000  ヤマハ 6000        
1002  ヤマハ 6000   1003  カワサ 5000  カノン  8000  ペンタ 5000
1003  カワサ 5000   1004  ナイコ 10000  オリン 10000        
1003  カノン 8000   1005  トヨタ  10000  ニサン 8000        
1003  ペンタ 5000
1004  ナイコ10000                                
1004  オリン 10000                                
1005  トヨタ 10000                                
1005  ニサン 8000                                 

VBAについては初心者で、いろいろ参考にしながら下記のコードを書きました。

----------------------------------------------------------------------
Sub yokonarabi()

Dim i As Long, ii As Long

'A列(コード)の最終セル
saishua = Cells(Rows.Count, 1).End(xlUp).Row
'E列(作業列)の最終セル
saishue = Cells(Rows.Count, 5).End(xlUp).Row

For i = 2 To saishua
  For ii = 2 To saishue
'コードと作業列の値が同じならば
    If Cells(i, 1).Value = Cells(ii, 5).Value Then
'作業列の右側空白セルに氏名と金額を貼り付け
    Range(Cells(i, 2), Cells(i, 3)).Copy Destination:= _
      Cells(ii, Columns.Count).End(xlToLeft).Offset(0, 1)
    Else
    End If
  Next
Next

End Sub
-----------------------------------------------------------------------

上記コードを実行したところ、うまく動いたのですが、本番で取り扱う表はA列が2万行近くあり、VBAを実行するとエクセルが固まってしまいます。
どのようにすれば、大量の行数にも対応できるようになるでしょうか。

是非、ご教授願います。
2 hits

【77720】縦並びを横並びにしたいです。 さと 15/12/6(日) 12:50 質問[未読]
【77721】Re:縦並びを横並びにしたいです。 γ 15/12/6(日) 13:58 発言[未読]
【77725】Re:縦並びを横並びにしたいです。 さと 15/12/6(日) 18:18 お礼[未読]
【77722】Re:縦並びを横並びにしたいです。 β 15/12/6(日) 14:39 発言[未読]
【77723】Re:縦並びを横並びにしたいです。 β 15/12/6(日) 15:23 発言[未読]
【77727】Re:縦並びを横並びにしたいです。 さと 15/12/6(日) 18:53 お礼[未読]

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