[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『指定の数だけ行をコピー＆挿入してくれる』（top724）
| 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)
| 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)
直前の変更のごみが、
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)
| 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)
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)
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)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.