Excel VBA質問箱 IV

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

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


12264 / 76734 ←次へ | 前へ→

【69996】Re:ある記号を含む場合、その記号の数だけ下にコピーしたいです。
発言  UO3  - 11/10/6(木) 9:52 -

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

おはようございます

ichinoseさんの回答の通り、まずは、基本的なループの中で、必要行数の挿入、コピーを行うコードを作り
その構成を習得されたらよろしいかと思います。

一方、データが多い場合、行の挿入、セルへのコピーでの書きこみは、結構処理時間がかかってしまいます。
このような場合、配列にできあがりイメージを作成しておいて一挙にシートに書きこむ方法も効果的です。

以下のコードは、まず基本を身につけられた後、お試し頂き参考にしてもらえれば幸甚です。
必要行数を調べるループ、次に実際の処理のためのループと、2回のループがありますが、
それでも、処理時間は、かなり短くなるはずです。

Sub Sample()
  Dim c As Range
  Dim vntF As Variant
  Dim vntT() As Variant
  Dim n As Long
  Dim x As Long
  Dim k As Long
  Dim j As Long
  Dim i As Long
  
  'シート上のリストに1列加えたものを配列に取り込む
  '追加の列には当該行のコピー後の行数を格納
  vntF = Range("A1", ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count).Offset(, 1)).Value
  
  '必要行数を事前調査
  For i = 1 To UBound(vntF, 1) '1行目から最終行まで
    x = 1
    If Len(vntF(i, 2)) > 0 Then 'データがあれば
      x = x + UBound(Split(vntF(i, 2), ".")) 'コピー行用に . の数を加算
    End If
    vntF(i, UBound(vntF, 2)) = x 'この行の新行数
    n = n + x  '必要行数
  Next
  
  'コピー&転記処理
  ReDim vntT(1 To n, 1 To UBound(vntF, 2) - 1) '出力用配列
  
  For i = 1 To UBound(vntF, 1) '1行目から最終行まで
    For x = 1 To vntF(i, UBound(vntF, 2))
      k = k + 1
      For j = 1 To UBound(vntT, 2)
        vntT(k, j) = vntF(i, j)
      Next
    Next
  Next
  
  Range("A1").Resize(UBound(vntT, 1), UBound(vntT, 2)).Value = vntT
  
End Sub
3 hits

【69993】ある記号を含む場合、その記号の数だけ下にコピーしたいです。 やみ 11/10/5(水) 23:32 質問
【69995】Re:ある記号を含む場合、その記号の数だけ... ichinose 11/10/6(木) 7:11 発言
【70006】Re:ある記号を含む場合、その記号の数だけ... やみ 11/10/7(金) 20:23 お礼
【69996】Re:ある記号を含む場合、その記号の数だけ... UO3 11/10/6(木) 9:52 発言
【70007】Re:ある記号を含む場合、その記号の数だけ... やみ 11/10/7(金) 20:26 お礼
【70008】Re:ある記号を含む場合、その記号の数だけ... kanabun 11/10/7(金) 20:53 発言
【70279】Re:ある記号を含む場合、その記号の数だけ... やみ 11/10/27(木) 21:51 お礼

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