[[20101202145924]] 『指定の数だけ行をコピー&挿入してくれる』(top724) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『指定の数だけ行をコピー&挿入してくれる』(top724)
バージョン Excel2007
 |    A    |    B    |    C    |    D    |    E    |    F    |    G    |
1  場所   商品   個数  箱の種類   箱の数    箱の種類   箱の数
2 東京   リンゴ   300  段ボール    2    紙袋    4
3 大阪   ボトル   500   風呂敷     1     紙袋    2
4 大阪    備考           冷蔵納品   ●      常温納品  ●
5 福岡   お菓子   100  段ボール    3    紙袋    2
6
上記のように各行にデータが入ってまして、E行を基準にしてコピー&挿入して
(この時、FとGはコピーしない)G行を基準にしてコピー&挿入をして下記の様に
なるにはどうしたらいいんでしょうか。みなさんどうか助けてください。
 |    A    |    B    |    C    |    D    |    E    |    F    |    G    |
1  場所   商品   個数  箱の種類   箱の数    箱の種類   箱の数
2 東京   リンゴ   300  段ボール    2    
3 東京   リンゴ   300  段ボール    2    
4 東京   リンゴ   300              紙袋    4
5 東京   リンゴ   300              紙袋    4
6 東京   リンゴ   300              紙袋    4
7 東京   リンゴ   300                     紙袋    4
8 大阪   ボトル   500   風呂敷     1      
9 大阪   ボトル   500               紙袋    2
10 大阪   ボトル   500               紙袋    2
11 大阪    備考           冷蔵納品   ●      常温納品  ●
12 福岡   お菓子   100  段ボール    3    
13 福岡   お菓子   100  段ボール    3    
14 福岡   お菓子   100  段ボール    3    
15 福岡   お菓子   100                     紙袋    2
16 福岡   お菓子   100                     紙袋    2
マクロの処理を行うと、こんな感じになるようにしたいです。(ちなみに
11行目みたいに数字じゃない場合は行を挿入せずそのままにしたいです)

どうぞ宜しくお願い致します。


 ●が必ずEとGにセットで入るなら問題ありませんが、そうでない場合は
 修正が必要です。
 Sub CopyENum()
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        CopyNums Range("G" & r), Range("D" & r).Resize(1, 2), False
        CopyNums Range("E" & r), Range("F" & r).Resize(1, 2), True
    Next
 End Sub

 Sub CopyNums(cr As Range, dr As Range, delRow As Boolean)
    If Not IsNumeric(cr.Value) Then Exit Sub
    Rows(cr.Row + 1 & ":" & cr.Row + cr.Value).Insert
    cr.EntireRow.Copy Destination:=Rows(cr.Row + 1 & ":" & cr.Row + cr.Value)
    dr.Offset(1, 0).Resize(cr.Value, dr.Columns.Count).Value = ""
    If delRow = True Then Rows(cr.Row).Delete
 End Sub
 (Mook)


Mookさん遅くなりましてすみません!
ありがとうございます。思ったようになりました!
・・・しかし、Mookさんがおっしゃったケースもある場合はどうしたらいいでしょうか?
たとえば、
 |    A    |    B    |    C    |    D    |    E    |    F    |    G    |
1  場所   商品   個数  箱の種類   箱の数    箱の種類   箱の数
2 東京   リンゴ   300  段ボール    2   
3 大阪   ボトル   500   風呂敷     1     紙袋    2
4 大阪    備考           冷蔵納品   ●      常温納品  ●
5 福岡   お菓子   100              紙袋    2
6
みたいに、どちらかの箱の種類だけになった場合です。
知らない事ばかりですが、どうか教えてください。(top724)

 どのようにしたいかは、top724 さんが決めることですが、上記の例の場合、
 どのような結果を期待するのでしょうか。

 2列目は箱だけ、5列目は紙袋だけ、4列目は・・・無くなってはまずいんですよね。
 となると、こんな感じでしょうか。
 Sub CopyENum()
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If CopyNums(Range("G" & r), Range("D" & r).Resize(1, 2)) = True _
        Or CopyNums(Range("E" & r), Range("F" & r).Resize(1, 2)) = True Then
             Rows(r).Delete
        End If
    Next
 End Sub

 Function CopyNums(cr As Range, dr As Range) As Boolean
    If Not IsNumeric(cr.Value) Then Exit Function
        CopyNums = False
    Else
        CopyNums = True
        Rows(cr.Row + 1 & ":" & cr.Row + cr.Value).Insert
        cr.EntireRow.Copy Destination:=Rows(cr.Row + 1 & ":" & cr.Row + cr.Value)
        dr.Offset(1, 0).Resize(cr.Value, dr.Columns.Count).Value = ""
    End If
 End Function
 (Mook)

返信が大変遅くなってすみません。
Mookさんから教えて頂いた文で、処理がスムーズに動きません。
「elseに対応するifがありません」と出ます・・・。
教えてください。(top724)

 直前の変更のごみが、

    If Not IsNumeric(cr.Value) Then Exit Function
        CopyNums = False
    Else
 を
    If Not IsNumeric(cr.Value) Then
        CopyNums = False
    Else
 としてください。
 (Mook)

 上記の処理(最新の分)を参考データ(これは私が上記に記載した文です)で実行したんですが、
 なぜかエラーがでます・・。私にはなにが原因なのかわかりません・・・。助けて下さい。
 (top724)

 Emptyのばあい、IsNumericの判定は「True」になるみたいですね。

 Application.IsNumber にかえてみてはどうでしょう。

 (HANA)


なりました!ありがとうございます!!
 Mookさん、何回もこんな私の質問に答えて下さってありがとうございます。
 HANAさん、助けて頂いてありがとうございます。
 (top724)

なんどもすみません・・・。
先日の件なんですが、箱の種類と箱の数が今まで2種類だったんですが、
3種類になりHとIの列が増えた場合はどんな分を足せばよろしいですか?
教えてください。
入力と出力結果は以下の様な感じです。
 |    A    |    B    |    C    |    D    |    E    |    F    |    G    |    H    |    I    |
1  場所   商品   個数  箱の種類   箱の数    箱の種類   箱の数 箱の種類   箱の数
2 東京   リンゴ   300  段ボール    2    紙袋    4   ビニール   2
3 大阪   ボトル   500   風呂敷     1     紙袋    2
4 大阪    備考           冷蔵納品   ●      常温納品  ●
5 福岡   お菓子   100  段ボール    3    紙袋    2   ビニール      3
6
結果として
 |    A    |    B    |    C    |    D    |    E    |    F    |    G    |    F    |    G    |
1  場所   商品   個数  箱の種類   箱の数    箱の種類   箱の数
2 東京   リンゴ   300  段ボール    2    
3 東京   リンゴ   300  段ボール    2    
4 東京   リンゴ   300              紙袋    4
5 東京   リンゴ   300              紙袋    4
6 東京   リンゴ   300              紙袋    4
7 東京   リンゴ   300                     紙袋    4
8 東京   リンゴ   300                                      ビニール   2
9 東京   リンゴ   300                              ビニール   2
10 大阪   ボトル   500   風呂敷     1      
11 大阪   ボトル   500               紙袋    2
12 大阪   ボトル   500               紙袋    2
13 大阪    備考           冷蔵納品   ●      常温納品  ●
14 福岡   お菓子   100  段ボール    3    
15 福岡   お菓子   100  段ボール    3    
16 福岡   お菓子   100  段ボール    3    
17 福岡   お菓子   100                     紙袋    2
18 福岡   お菓子   100                     紙袋    2
19 福岡   お菓子   100                              ビニール   3
20 福岡   お菓子   100                                      ビニール   3
21 福岡   お菓子   100                                      ビニール   3
宜しくお願い致します
(top724)


 現在のコードがどうなっているか理解できたでしょうか。

 現在のコードをベースに変更するのであれば、 基本的には行をコピーして不要な
 部分を消しているので、消す部分を2箇所指定すればできるようになると思います。

 各部分のコピーをした場合、コピー元行を削除するというロジックなので、
 呼び出し側は、If 文の列の追加だけでできると思います。
 コピーした行は下に延びていくので、後ろの列から処理していますので、
 その点を留意して追加してください。
 (Mook)

Mookさん コードをきれいに理解できません・・・。
CopyNumsというのがコピーをする分なのでしょうか?

If CopyNums(Range("G" & r), Range("D" & r).Resize(1, 2)) = True _

        Or CopyNums(Range("E" & r), Range("F" & r).Resize(1, 2)) = True Then
             Rows(r).Delete
の意味を教えて頂けないでしょうか。
ほんとに基本的なものから勉強しなくてはと、痛感している次第です・・。

それで、具体的にはどの部分にどの様な文を足したらいいのでしょうか?
(top724)


 まず CopyNums の動き自体を理解してください。
 これは 最初の引数で指定されたセルの数値だけ、行を挿入し
        Rows(cr.Row + 1 & ":" & cr.Row + cr.Value).Insert
 コピー元の行を挿入した行にコピーし、
        cr.EntireRow.Copy Destination:=Rows(cr.Row + 1 & ":" & cr.Row + cr.Value)
 2番目の引数で、指定した範囲を削除する
        dr.Offset(1, 0).Resize(cr.Value, dr.Columns.Count).Value = ""
 という処理をしています。このあたりはステップ実行しながら EXCEL 画面をみれば
 すぐに理解できるでしょう。

 第一引数が数値でなかった場合コピーを行わないので、
 コピーをしたか(CopyNums = True)しなかったか(CopyNums = False)を
 返すことにより呼び出し側が結果を認識します。

  今回の構造は
  If  最初の処理 = True Or 2番目の処理 = True Then
               Rows(r).Delete
  ということでどっちか少なくとも一方が処理されてたら、元の行は消す
  という処理になります。

 今回、これに3番目の処理を追加するのですから、
  If  最初の処理 = True Or 2番目の処理 = True Or 3番目の処理 = True Then
 とするとともに、処理先である CopyNums は、2か所を消して1か所だけを残すという
 処理に変更します。
 (Mook)

 一応修正案です。
      CopyNums は、2か所を消して1か所だけを残すという
 ではなく、
      CopyRowN は、D〜Iを全部消して必要な部分だけ再度コピーする
 という処理に変更しています。
 これにより、もう一列追加という場合はこの関数は変更しなくて良いようにできるはずです。

 数字の指定が4列になったら、という変更を今のうちに御自身で試しておいてはどうでしょうか。

 Sub top724Copy()
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If CopyRowN(Range("I" & r), Range("D" & r).Resize(1, 6), Range("H" & r).Resize(1, 2)) = True _
        Or CopyRowN(Range("G" & r), Range("D" & r).Resize(1, 6), Range("F" & r).Resize(1, 2)) = True _
        Or CopyRowN(Range("E" & r), Range("D" & r).Resize(1, 6), Range("D" & r).Resize(1, 2)) = True Then
            Rows(r).Delete
        End If
    Next
 End Sub

 Function CopyRowN(numCell As Range, clearArea As Range, reCopyArea As Range) As Boolean
    If Not Application.IsNumber(numCell.Value) Then
 '--- 戻り値の設定:numCell が数字なら False
        CopyRowN = False
    Else
 '--- 戻り値の設定:numCell が数字なら True
        CopyRowN = True
   '-- numCell 数だけ行を挿入
        Rows(numCell.Row + 1 & ":" & numCell.Row + numCell.Value).Insert
   '-- 挿入先に numCell の行をコピー
        numCell.EntireRow.Copy Destination:=Rows(numCell.Row + 1 & ":" & numCell.Row + numCell.Value)
   '-- 一旦 clearArea の列相当を削除
        clearArea.Offset(1, 0).Resize(numCell.Value, clearArea.Columns.Count).Value = ""
   '-- reCopyArea を再コピー
        reCopyArea.Copy Destination:=reCopyArea.Offset(1, 0).Resize(numCell.Value, reCopyArea.Columns.Count)
    End If
 End Function

 (Mook)

Mookさん ありがとうございます!
勉強させて頂きました!ほんと感謝です。
それで一点質問させて頂いてもいいですか・・・。
For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If CopyRowN(Range("I" & r), Range("D" & r).Resize(1, 6), Range("H" & r).Resize(1, 2)) = True _
        Or CopyRowN(Range("G" & r), Range("D" & r).Resize(1, 6), Range("F" & r).Resize(1, 2)) = True _
        Or CopyRowN(Range("E" & r), Range("D" & r).Resize(1, 6), Range("D" & r).Resize(1, 2)) = True Then
            Rows(r).Delete
        End If
    Next
ここの文の考え方がわかりません。ご教授下さい。
特にrangeのかっこの中とその並びがなぜそういうふうになるのか、
どういう動きをしているのか、が分かりません。
面倒な質問ですが、どうぞ宜しくお願い致します。
(top724)

 このような確認の質問でしたら大歓迎です。
 提示したコードは少し分かりづらいかもしれませんが、下記のように分解して
 みると少しは分かるでしょうか。
 結果を一次変数に入れるようにしただけですが、やっていることはまったく
 一緒です。
 ------
    Dim コピー処理が有ったか1 As Boolean
    Dim コピー処理が有ったか2 As Boolean
    Dim コピー処理が有ったか3 As Boolean

    Dim 最後の行 As Long
    最後の行 = Range("A" & Rows.Count).End(xlUp).Row

    Dim 行 As Long
    For 行 = 最後の行 To 2 Step -1
        コピー処理が有ったか1 = CopyRowN(Range("I" & 行), Range("D" & 行).Resize(1, 6), Range("H" & 行).Resize(1, 2))
        コピー処理が有ったか2 = CopyRowN(Range("G" & 行), Range("D" & 行).Resize(1, 6), Range("F" & 行).Resize(1, 2))
        コピー処理が有ったか3 = CopyRowN(Range("E" & 行), Range("D" & 行).Resize(1, 6), Range("D" & 行).Resize(1, 2))

        If (コピー処理が有ったか1 = True) Or (コピー処理が有ったか2 = True) Or (コピー処理が有ったか3 = True) Then
            Rows(行).Delete
        End If
    Next
 ------
 CopyRowN の 順を変えてみれば、なぜ H,F,D の順序で処理しているかが分かると思います。
 (Mook)

Mookさん!ほんとうに。ほんとうにありがとうございました!!
またご教授頂ける日を心待ちにして勉強いたします!w
ありがとうございました。感謝。
(top724)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.