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 -

引用なし
パスワード
   例えば
 A B C D E 
 1 aaa 良 2 1X
 2 bbb 良 3 
 3 ccc 良 1   
 4 ddd 不 1 1T
 5 eee 不 2   

条件1 E列=空欄のモノ and
条件2 D列=1以外のモノ

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

教えてください。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列が1ではなく、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| A | B | C | D | E | 
---+----+----+----+----+----+
行2| 1 | aaa| 良 |  2| 1X|
---+----+----+----+----+----+
行3| 2 | bbb| 良 |  3|  |
---+----+----+----+----+----+
行4| 3 | ccc| 良 |  1|  |
---+----+----+----+----+----+
行5| 4 | ddd| 不 |  1| 1T|
---+----+----+----+----+----+
行6| 5 | eee| 不 |  2|  |
---+----+----+----+----+----+
※表の範囲はA1:E6

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

  | A列| B列| C列| D列| E列| 
---+----+----+----+----+----+
行1| A | B | C | D | E | 
---+----+----+----+----+----+
行2| 1 | aaa| 良 |  2| 1X|
---+----+----+----+----+----+
行3| 2 | bbb| 良 |  3|  |
---+----+----+----+----+----+
行4| 3 | ccc| 良 |  1|  |
---+----+----+----+----+----+
行5| 4 | ddd| 不 |  1| 1T|
---+----+----+----+----+----+
行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