Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4848 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【54065】条件付　行のコピー貼り付け 裕香 08/2/22(金) 16:20 質問[未読]
【54068】Re:条件付　行のコピー貼り付け ひげくま 08/2/22(金) 17:34 発言[未読]
【54069】Re:条件付　行のコピー貼り付け 裕香 08/2/22(金) 18:44 質問[未読]
【54070】Re:条件付　行のコピー貼り付け ponpon 08/2/22(金) 23:04 発言[未読]
【54073】Re:条件付　行のコピー貼り付け 裕香 08/2/23(土) 9:00 質問[未読]
【54074】Re:条件付　行のコピー貼り付け ponpon 08/2/23(土) 10:37 発言[未読]
【54076】Re:条件付　行のコピー貼り付け 裕香 08/2/23(土) 13:26 質問[未読]
【54078】Re:条件付　行のコピー貼り付け りん 08/2/23(土) 18:04 発言[未読]
【54093】Re:条件付　行のコピー貼り付け ［名前なし］ 08/2/24(日) 10:49 お礼[未読]
【54080】Re:条件付　行のコピー貼り付け ponpon 08/2/23(土) 20:01 発言[未読]
【54094】Re:条件付　行のコピー貼り付け 優香 08/2/24(日) 10:53 お礼[未読]
【54065】条件付　行のコピー貼り付け
質問  裕香 E-MAIL  - 08/2/22(金) 16:20 -
引用なし
パスワード
   例えば
　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　
　1　aaa　良　2　1Ｘ
　2　bbb　良　3　
　3　ccc　良　1　　　
　4　ddd　不　1　1Ｔ
　5　eee　不　2　　　

条件1　Ｅ列＝空欄のモノ　and
条件2　Ｄ列＝1以外のモノ

これで絞ると、2行目と5行目が該当します。
このデータを複製し、最終行にデータ追加したいのです。
複製の数は、
Ｄ列＝2の時は1個追加、　
Ｄ列＝3の時は2個追加　というように、Ｄ列の数字-1の
回数だけ複製したいのですが、ＶＢＡでどう書けば良いですか？

教えてください。m(_ _)m
【54068】Re:条件付　行のコピー貼り付け
発言  ひげくま  - 08/2/22(金) 17:34 -
引用なし
パスワード
   VBAのことをまったく知らなくて、単なる作成依頼、というわけではないんですよね？
ご自分でどこまで考えているのかを提示したほうが良いと思いますよ。

単純に考えると、
・1行目から順にD列とE列をチェック
・D列が1以外＆E列が空欄だったら、最終行の1つ下の行に、D列の値-1の数だけ、その行をコピー
というだけで済みそうですね。
でも、これだけだと、永遠に続いてしまうので、最初の行数を覚えておいて、そこで終わるようにしないといけませんね。
【54069】Re:条件付　行のコピー貼り付け
質問  裕香 E-MAIL  - 08/2/22(金) 18:44 -
引用なし
パスワード
   ▼ひげくま さん：
ありがとうございます。m(_ _)m

>VBAのことをまったく知らなくて、単なる作成依頼、というわけではないんですよね？
>ご自分でどこまで考えているのかを提示したほうが良いと思いますよ。
　↓
そうですよね。すみませんでした。
本当は全く知らないに等しいと思います。マクロの記録をして、
ちょこっと直す程度なので、恥ずかしくて書けませんでした。
実は、こんな感じでやってはいるものの、考えが及ばなくなったので・・・

Dim st As Integer

　'対象データを検索
　　Selection.AutoFilter
　　Selection.AutoFilter Field:=5, Criteria1:="="
　　Selection.AutoFilter Field:=4, Criteria1:="<>1" = st
　　
　　
　　If st = 2 Then

　　Range("A2:E2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　
　 '最終行にｺﾋﾟｰ
　　Range("A65536").End(Xlup).offset(1).Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　
　　End If
　　
　　
　　If st = 3 Then
　　
　　Range("A2:E2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　・・・・？？？


>単純に考えると、
>・1行目から順にD列とE列をチェック
>・D列が1以外＆E列が空欄だったら、最終行の1つ下の行に、D列の値-1の数だけ、その行をコピー>というだけで済みそうですね。
　　↓
このD列の値-1の数だけ　って事がどうしても？？？

すみません。初心者で。
【54070】Re:条件付　行のコピー貼り付け
発言  ponpon  - 08/2/22(金) 23:04 -
引用なし
パスワード
   ▼裕香 さん：
ひげくま さんのアドバイス通りに作ってみました。
アクティブシートで考えています。

Option Explicit

Sub test()
　　Dim i As Long
　　
　　’画面更新の停止
　　Application.ScreenUpdating = False

　　’項目行が1行目にあるとして、2行目からD列の終わりの行まで
　　For i = 2 To Range("D" & Rows.Count).End(xlUp).Row

　　　’もし、D列が１ではなく、E列が空白なら
　　　If Cells(i, 4).Value <> 1 And Cells(i, 5).Value = "" Then

　　　　’その行のA列からE列までをコピーして　
　　　　 Cells(i, 4).Offset(, -3).Resize(, 5).Copy _

　　　　’A列の最終行の次にD列の値-1の数だけ貼り付けろ
　　　　 Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)
　　　 End If

　　’次の行へ
　　Next

　　’画面更新の再開
　　Application.ScreenUpdating = False
End Sub
【54073】Re:条件付　行のコピー貼り付け
質問  裕香 E-MAIL  - 08/2/23(土) 9:00 -
引用なし
パスワード
   ▼ponpon さん：
ありがとうございます。
こんなにもコンパクトに出来るんだなって感激しています。

でも・・
>’A列の最終行の次にD列の値-1の数だけ貼り付けろ
> Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)


の所で、Resizeを使うとストップしてしまいます。
Resizeﾌﾟﾛﾊﾟﾃｨは、選択範囲を変更するって事ですよね、
どうしたらイイですか？
【54074】Re:条件付　行のコピー貼り付け
発言  ponpon  - 08/2/23(土) 10:37 -
引用なし
パスワード
   ▼裕香 さん：
>でも・・
>>’A列の最終行の次にD列の値-1の数だけ貼り付けろ
>> Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)
>どうしたらイイですか？
こちらに貼り付ける際にドジってたようです。
久しぶりに回答するとこれだよ！！

Option Explicit

Sub test()
　　Dim i As Long
　
　　Application.ScreenUpdating = False
　　For i = 2 To Range("D" & Rows.Count).End(xlUp).Row
　　　If Cells(i, 4).Value <> 1 And Cells(i, 5).Value = "" Then
　　　　 Cells(i, 4).Offset(, -3).Resize(, 5).Copy _
　　　　 Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)
　　　 End If
　　Next
　　Application.ScreenUpdating = False
End Sub
【54076】Re:条件付　行のコピー貼り付け
質問  裕香 E-MAIL  - 08/2/23(土) 13:26 -
引用なし
パスワード
   ▼ponpon さん：
度々すみません。ありがとうございます。
・・・？？

昨日回答していただいた文 Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value -　
今日回答していただいた文　Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)

一緒なんですけど・・・？？？
Resizeは「プロパティの使い方が不正」となります。
ponpon さん　何回も聞いてﾎﾝﾄ申し訳ないですけど

Resize(Cells(i, 4).Value - 1)
　↑
セル(i，4）に入っている数字から　-1　した数字　という事ですよね。
例えば、3　なら　2　、5　なら　4ということですよね。
その数字と同じ回数だけ、先にｺﾋﾟｰしたデータを貼り付けろ　って
どう表現したらいいのでしょうか？

「その数字と同じ回数だけ」　←　これが私の頭では考えられません。

どうか、よろしくお願いいたします。
【54078】Re:条件付　行のコピー貼り付け
発言  りん E-MAIL  - 08/2/23(土) 18:04 -
引用なし
パスワード
   　 　　　　裕香 さん、こんばんわ。

　 | A列| B列| C列| D列| E列|　
---+----+----+----+----+----+
行1| Ａ | Ｂ | Ｃ | Ｄ | Ｅ |　
---+----+----+----+----+----+
行2|　1 | aaa| 良 |　 2| 1Ｘ|
---+----+----+----+----+----+
行3|　2 | bbb| 良 |　 3|　　|
---+----+----+----+----+----+
行4|　3 | ccc| 良 |　 1|　　|
---+----+----+----+----+----+
行5|　4 | ddd| 不 |　 1| 1Ｔ|
---+----+----+----+----+----+
行6|　5 | eee| 不 |　 2|　　|
---+----+----+----+----+----+
※表の範囲はA1:E6

このように入力されてるシートを表示して、ponpon さんの前回のコードを標準モジュールに貼り付けて実行したら、

　 | A列| B列| C列| D列| E列|　
---+----+----+----+----+----+
行1| Ａ | Ｂ | Ｃ | Ｄ | Ｅ |　
---+----+----+----+----+----+
行2|　1 | aaa| 良 |　 2| 1Ｘ|
---+----+----+----+----+----+
行3|　2 | bbb| 良 |　 3|　　|
---+----+----+----+----+----+
行4|　3 | ccc| 良 |　 1|　　|
---+----+----+----+----+----+
行5|　4 | ddd| 不 |　 1| 1Ｔ|
---+----+----+----+----+----+
行6|　5 | eee| 不 |　 2|　　|
---+----+----+----+----+----+
行7|　2 | bbb| 良 |　 3|　　|
---+----+----+----+----+----+
行8|　2 | bbb| 良 |　 3|　　|
---+----+----+----+----+----+
行9|　5 | eee| 不 |　 2|　　|
---+----+----+----+----+----+
こんな形になりました。
※転記後データの範囲はA1:E9

XL2003およびXL2007で動作確認。
【54080】Re:条件付　行のコピー貼り付け
発言  ponpon  - 08/2/23(土) 20:01 -
引用なし
パスワード
   おかしいな。
こちらでは、ちゃんとコピペできてるんですが・・・
1回目と2回目では微妙に違うのですが・・・
こうしたら？

Sub test()
　　Dim i As Long
　
　　Application.ScreenUpdating = False

　　For i = 2 To Range("D" & Rows.Count).End(xlUp).Row
　　　　If Cells(i, 4).Value <> 1 And Cells(i, 5).Value = "" Then
　　　　　　Cells(i, 4).Offset(, -3).Resize(, 5).Copy Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)
　　　　 End If
　　Next
　　Application.ScreenUpdating = False
End Sub
【54093】Re:条件付　行のコピー貼り付け
お礼  ［名前なし］  - 08/2/24(日) 10:49 -
引用なし
パスワード
   ▼りん さん：


XL2003およびXL2007で動作確認。
　　↓
ん？　そうか会社のPCは2000なんです。
もしかしたら、コレ？？

そう思って、帰って家(XP)でやってみたら、
出来てました(●´∀｀●)

ﾋﾝﾄをありがとうございました。
【54094】Re:条件付　行のコピー貼り付け
お礼  優香  - 08/2/24(日) 10:53 -
引用なし
パスワード
   ▼ponpon さん：

本当にありがとうございました。
ponponさんからの最初回答で出来てました☆

コレを気に、VBAに色々挑戦してみます。
ここに書き込みして良かったです。

VBA質問箱ってイイですね！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4848 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free