Excel VBA質問箱 IV

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

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


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

【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 お礼[未読]

【69993】ある記号を含む場合、その記号の数だけ下...
質問  やみ  - 11/10/5(水) 23:32 -

引用なし
パスワード
   B列に「・」がある場合その行をコピーしたいです。

りんご|いちご・なし・ぶどう|すいか|メロン|
キリン|サル        |タヌキ|ネズミ|

りんご|いちご・なし・ぶどう|すいか|メロン|
りんご|いちご・なし・ぶどう|すいか|メロン|
りんご|いちご・なし・ぶどう|すいか|メロン|
キリン|サル        |タヌキ|ネズミ|


「・」が二つあるので下に2行コピーしました。

お知恵を貸してください。

【69995】Re:ある記号を含む場合、その記号の数だ...
発言  ichinose  - 11/10/6(木) 7:11 -

引用なし
パスワード
   おはようございます。

>B列に「・」がある場合その行をコピーしたいです。
>
>りんご|いちご・なし・ぶどう|すいか|メロン|
>キリン|サル        |タヌキ|ネズミ|
>↓
>りんご|いちご・なし・ぶどう|すいか|メロン|
>りんご|いちご・なし・ぶどう|すいか|メロン|
>りんご|いちご・なし・ぶどう|すいか|メロン|
>キリン|サル        |タヌキ|ネズミ|
>
>
>「・」が二つあるので下に2行コピーしました。
>
>お知恵を貸してください。

まず、繰り返し処理を行う

For〜Next文
For Each In 〜 Next文
Do While 〜Loop文
Do Until 〜Loop文

は、わかりますか?
殆どのプログラムには、必要ですから、知らなければ調べてください。


>「・」がある場合その行をコピーしたいです。

・ の数は、

Sub test()
  Dim cnt As Long
  cnt = UBound(Split(Range("b1").Value, "・"))
  MsgBox cnt
End Sub

こんな方法で得られます(但し、cntは、何も入力されていないと-1を返すので注意)

>行コピー

行のコピーはマクロの記録を使って、おおよその見当を付けてください。

【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

【70006】Re:ある記号を含む場合、その記号の数だ...
お礼  やみ  - 11/10/7(金) 20:23 -

引用なし
パスワード
   ▼ichinose さん:
>おはようございます。
>
>>B列に「・」がある場合その行をコピーしたいです。
>>
>>りんご|いちご・なし・ぶどう|すいか|メロン|
>>キリン|サル        |タヌキ|ネズミ|
>>↓
>>りんご|いちご・なし・ぶどう|すいか|メロン|
>>りんご|いちご・なし・ぶどう|すいか|メロン|
>>りんご|いちご・なし・ぶどう|すいか|メロン|
>>キリン|サル        |タヌキ|ネズミ|
>>
>>
>>「・」が二つあるので下に2行コピーしました。
>>
>>お知恵を貸してください。
>
>まず、繰り返し処理を行う
>
>For〜Next文
>For Each In 〜 Next文
>Do While 〜Loop文
>Do Until 〜Loop文
>
>は、わかりますか?
>殆どのプログラムには、必要ですから、知らなければ調べてください。
>
>
>>「・」がある場合その行をコピーしたいです。
>
>・ の数は、
>
>Sub test()
>  Dim cnt As Long
>  cnt = UBound(Split(Range("b1").Value, "・"))
>  MsgBox cnt
>End Sub
>
>こんな方法で得られます(但し、cntは、何も入力されていないと-1を返すので注意)
>
>>行コピー
>
>行のコピーはマクロの記録を使って、おおよその見当を付けてください。


ありがとうございました

何度も
>まず、繰り返し処理を行う
>
>For〜Next文
>For Each In 〜 Next文
>Do While 〜Loop文
>Do Until 〜Loop文
>
>は、わかりますか?
については説明を読んでいるのですが、それが
自分のやりたい事にどうつなげればいいのかが
いつもわかりません。。。

もう少し勉強してみます!

ありがとうございました!

【70007】Re:ある記号を含む場合、その記号の数だ...
お礼  やみ  - 11/10/7(金) 20:26 -

引用なし
パスワード
   ▼UO3 さん:
>▼やみ さん:
>
>おはようございます
>
>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
ありがとうございます!!!!
ものすごく丁寧に説明してくださって、本当に感謝しています。
どういう順序で考えていくかを書いてくださっているので
とても勉強になり、印刷して何度も読み返しています。
頂いたコードをひとつひとつ確認していきたいと思います。
本当に本当にありがとうございました。

【70008】Re:ある記号を含む場合、その記号の数だ...
発言  kanabun  - 11/10/7(金) 20:53 -

引用なし
パスワード
   ▼やみ さん:
もうすでに解決かもしれませんが、時間のことを考えないなら
シート上で手作業でやる操作をマクロにしてみるのもいいです。
手作業でやるときは、最下行から見て行って、
B列の「・」の数がたとえば 2個あれば
まずその行をCopyして下に2行挿入、という手順になると思います。
行挿入や行削除問題では、この「下から」処理していくという方向が
ポイントです。

Sub Try1() 'B列の「・」の数だけ下に行挿入Copy
 Dim i As Long
 Dim n As Long
 For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1'最下行から上へ
   n = UBound(Split(Cells(i, 2).Value, "・"))
   If n > 0 Then
     Rows(i).Copy
     Rows(i + 1).Resize(n).Insert
   End If
 Next
End Sub

【70279】Re:ある記号を含む場合、その記号の数だ...
お礼  やみ  - 11/10/27(木) 21:51 -

引用なし
パスワード
   ▼kanabun さん:
初めまして!!このページを見るのが遅くなってしまって
本当に申し訳ありません。
すごく勉強になります。やってみます。
ありがとうございました!!!


>▼やみ さん:
>もうすでに解決かもしれませんが、時間のことを考えないなら
>シート上で手作業でやる操作をマクロにしてみるのもいいです。
>手作業でやるときは、最下行から見て行って、
>B列の「・」の数がたとえば 2個あれば
>まずその行をCopyして下に2行挿入、という手順になると思います。
>行挿入や行削除問題では、この「下から」処理していくという方向が
>ポイントです。
>
>Sub Try1() 'B列の「・」の数だけ下に行挿入Copy
> Dim i As Long
> Dim n As Long
> For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1'最下行から上へ
>   n = UBound(Split(Cells(i, 2).Value, "・"))
>   If n > 0 Then
>     Rows(i).Copy
>     Rows(i + 1).Resize(n).Insert
>   End If
> Next
>End Sub

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