Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10210 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【23094】データの抽出について indy 05/3/12(土) 23:46 質問[未読]
【23098】Re:データの抽出について ponpon 05/3/13(日) 0:32 回答[未読]
【23102】Re:データの抽出について indy 05/3/13(日) 16:25 質問[未読]
【23105】Re:データの抽出について ponpon 05/3/13(日) 19:36 発言[未読]
【23107】Re:データの抽出について ponpon 05/3/13(日) 20:38 回答[未読]
【23113】Re:データの抽出について indy 05/3/13(日) 23:38 お礼[未読]
【23106】Re:データの抽出について かみちゃん 05/3/13(日) 20:20 回答[未読]
【23114】Re:データの抽出について indy 05/3/13(日) 23:56 お礼[未読]
【23094】データの抽出について
質問  indy  - 05/3/12(土) 23:46 -
引用なし
パスワード
   教えて下さい。
マクロを起動したら、
sheet1
　 A　　　　B　　C
1 品目 　　A店　B店
2 みかん　 500　700
3 りんご　 800　800　　
4 バナナ　 300　450
5　 :　　　 :　　:
6
というデータを
sheet2
　 A　　　　B　　C
1 品目 　　A店　B店
2 みかん　 500　700
3 バナナ　 300　450　　
4　 :　　　 :　　:
5
というふうにsheet1からA店とB店の数が違うもの（B列とC列の数が違うもの）
だけのデータを別シート（sheet2)に入れていきたいのですが、
どのようにすればいいのでしょうか。行は可変です。
ご教授の程、宜しくお願い致します。
【23098】Re:データの抽出について
回答  ponpon  - 05/3/13(日) 0:32 -
引用なし
パスワード
   ▼indy さん：
ponponです。こんばんは。

こんな感じでいかがでしょう。
あまりスマートではありませんが、
Sub test()
　　Dim myRng As Range
　　Dim myRng2 As Range
　　Dim r As Range
　　
　　With Worksheets("sheet1")
　　　　 Set myRng = .Range(.Range("B2"), .Range("B65536").End(xlUp))
　　　　 For Each r In myRng
　　　　　 If r <> "" Then
　　　　　　 If r.Value <> r.Offset(, 1).Value Then
　　　　　　　　Set myRng2 = Worksheets("sheet2").Range("A65536").End _
　　　　　　　　　　(xlUp).Offset(1, 0)
　　　　　　　　Worksheets("sheet2").Range("A1").Resize(1, 3).Value _
　　　　　　　　 = .Range("A1").Resize(1, 3).Value
　　　　　　　　myRng2.Resize(1, 3).Value = r.Offset(, -1) _
　　　　　　　　　　　　　　　　　　　　　　.Resize(1, 3).Value
　　　　　　 End If
　　　　　 End If
　　　　 Next
　　End With

End Sub


>sheet1
>　 A　　　　B　　C
>1 品目 　　A店　B店
>2 みかん　 500　700
>3 りんご　 800　800　　
>4 バナナ　 300　450
>5　 :　　　 :　　:
>6
>というデータを
>sheet2
>　 A　　　　B　　C
>1 品目 　　A店　B店
>2 みかん　 500　700
>3 バナナ　 300　450　　
>4　 :　　　 :　　:
>5
>というふうにsheet1からA店とB店の数が違うもの（B列とC列の数が違うもの）
>だけのデータを別シート（sheet2)に入れていきたいのですが、
>どのようにすればいいのでしょうか。行は可変です。
>ご教授の程、宜しくお願い致します。
>
>
【23102】Re:データの抽出について
質問  indy  - 05/3/13(日) 16:25 -
引用なし
パスワード
   ▼ponpon さん：
こんにちは、indyです。
この度は教えて頂きどうもありがとうございます。
お蔭様でできました！ありがとうございます！
それで、これのちょっと違った形なのですが、
sheet1
　 A　　　 　B　　・ ・・・・ M　 N
1 品目CODE　品目　　　　　　 A店　B店
2 001　　　みかん　　　　　　500　700
3 002　　　りんご　　　　　　800　800　　
4 003　　　バナナ　　　　　　300　450
5　 :　　　 :　　　　　　　 　:
6
というデータを
sheet2
　 A　　　　 B　　　 C　　D
1 品目CODE　品目　　A店　B店
2 001　　　みかん　 500　700
3 003　　　バナナ　 300　450　　
4　 :　　　 :　　　　:
5
と、条件は変わらないのですが、sheet1のデータが離れてしまっている
(DからL列は条件には関係のないデータが入っています）
ものをsheet2のようにしたい時はどのように書けばいいのでしょうか・・。
初心者の為、お手数おかけ致します。
宜しくお願いします。

>▼indy さん：
>ponponです。こんばんは。
>
>こんな感じでいかがでしょう。
>あまりスマートではありませんが、
>Sub test()
>　　Dim myRng As Range
>　　Dim myRng2 As Range
>　　Dim r As Range
>　　
>　　With Worksheets("sheet1")
>　　　　 Set myRng = .Range(.Range("B2"), .Range("B65536").End(xlUp))
>　　　　 For Each r In myRng
>　　　　　 If r <> "" Then
>　　　　　　 If r.Value <> r.Offset(, 1).Value Then
>　　　　　　　　Set myRng2 = Worksheets("sheet2").Range("A65536").End _
>　　　　　　　　　　(xlUp).Offset(1, 0)
>　　　　　　　　Worksheets("sheet2").Range("A1").Resize(1, 3).Value _
>　　　　　　　　 = .Range("A1").Resize(1, 3).Value
>　　　　　　　　myRng2.Resize(1, 3).Value = r.Offset(, -1) _
>　　　　　　　　　　　　　　　　　　　　　　.Resize(1, 3).Value
>　　　　　　 End If
>　　　　　 End If
>　　　　 Next
>　　End With
>
>End Sub
>
>
>>sheet1
>>　 A　　　　B　　C
>>1 品目 　　A店　B店
>>2 みかん　 500　700
>>3 りんご　 800　800　　
>>4 バナナ　 300　450
>>5　 :　　　 :　　:
>>6
>>というデータを
>>sheet2
>>　 A　　　　B　　C
>>1 品目 　　A店　B店
>>2 みかん　 500　700
>>3 バナナ　 300　450　　
>>4　 :　　　 :　　:
>>5
>>というふうにsheet1からA店とB店の数が違うもの（B列とC列の数が違うもの）
>>だけのデータを別シート（sheet2)に入れていきたいのですが、
>>どのようにすればいいのでしょうか。行は可変です。
>>ご教授の程、宜しくお願い致します。
>>
>>
【23105】Re:データの抽出について
発言  ponpon  - 05/3/13(日) 19:36 -
引用なし
パスワード
   ▼indy さん：
ponpon です。こんばんは。
offsetとresizeをヘルプで調べればできると思います。

>sheet1
>　 A　　　 　B　　・ ・・・・ M　 N
>1 品目CODE　品目　　　　　　 A店　B店
>2 001　　　みかん　　　　　　500　700
>3 002　　　りんご　　　　　　800　800　　
>4 003　　　バナナ　　　　　　300　450
>5　 :　　　 :　　　　　　　 　:
>6
>というデータを
>sheet2
>　 A　　　　 B　　　 C　　D
>1 品目CODE　品目　　A店　B店
>2 001　　　みかん　 500　700
>3 003　　　バナナ　 300　450　　
>4　 :　　　 :　　　　:
>5
>と、条件は変わらないのですが、sheet1のデータが離れてしまっている
>(DからL列は条件には関係のないデータが入っています）
>ものをsheet2のようにしたい時はどのように書けばいいのでしょうか・・。
>初心者の為、お手数おかけ致します。
>宜しくお願いします。

>>Sub test()
>>　　Dim myRng As Range
>>　　Dim myRng2 As Range
>>　　Dim r As Range
>>　　
>>　　With Worksheets("sheet1")
>>　　　　 Set myRng = .Range(.Range("B2"), .Range("B65536").End(xlUp))
　　　　　　　　　　　　　　　　　　↑　　　　　　　↑
　　　　　　　　　　　　　　　　　　M2にかえる　　　M65536にかえる。
>>　　　　 For Each r In myRng
>>　　　　　 If r <> "" Then
>>　　　　　　 If r.Value <> r.Offset(, 1).Value Then
>>　　　　　　　　Set myRng2 = Worksheets("sheet2").Range("A65536").End _
>>　　　　　　　　　　(xlUp).Offset(1, 0)
>>　　　　　　　　Worksheets("sheet2").Range("A1").Resize(1, 3).Value _
>>　　　　　　　　 = .Range("A1").Resize(1, 3).Value
　　　　　　　　　　↑
　　　　　　　　　ここは、A1：B1　とC1：D1に分けて考える。
　　　　　　　　　　↓
>>　　　　　　　　myRng2.Resize(1, 3).Value = r.Offset(, -1) _
>>　　　　　　　　　　　　　　　　　　　　　　.Resize(1, 3).Value

　　　　　　　　　　　↑ここも、ｒからどれくらいoffsetするか考える

>>　　　　　　 End If
>>　　　　　 End If
>>　　　　 Next
>>　　End With
>>
>>End Sub

　自分でがんばってみてください。
　後sheet2のA列は書式を文字列にしないといけません。
【23106】Re:データの抽出について
回答  かみちゃん  - 05/3/13(日) 20:20 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>それで、これのちょっと違った形なのですが、

もしかして、初めから、そういう要件ではなかったのでしょうか？
もし、そうであれば、今後ご質問される場合は、最初からできるだけ要件を出していただいたほうがよろしいかと思います。

さて、すでに、ponponさんからコメントも出ていますが、OffsetとResizeを使わず
（Offsetは一箇所だけ使っていますが）値をCopyする方法ほ紹介しておきますので
参考にしてください。

Option Explicit
Sub test2()
　Dim myRng As Range
　Dim myRng2 As Range
　Dim r As Range
　
　With Worksheets("Sheet1")
　　'A2からA列の最下端のセルまでの範囲を処理する範囲とする。
　　Set myRng = .Range(.Range("A1"), .Cells(.Columns("A").Rows.Count, .Columns("A").Column).End(xlUp))
　　For Each r In myRng
　　　'M列とN列のデータを比較し、異なる値の場合のみ処理をする。
　　　If Cells(r.Row, .Columns("M").Column).Value <> Cells(r.Row, .Columns("N").Column).Value Then
　　　　Set myRng2 = Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
　　　　'品目コードと品目をコピー
　　　　.Range(.Cells(r.Row, .Columns("A").Column), .Cells(r.Row, .Columns("B").Column)).Copy Destination:=myRng2
　　　　'M列の値とN列の値をコピー
　　　　.Range(.Cells(r.Row, .Columns("M").Column), .Cells(r.Row, .Columns("N").Column)).Copy Destination:=myRng2.Offset(, 2)
　　　End If
　　Next
　End With
End Sub

あと、蛇足で、ponponさんには一度申し上げたことがあるのですが、掲示板中の引
用は、必要最小限のものでもよろしいかと思います。
ツリー表示で、一連の内容は、わかりますから。
【23107】Re:データの抽出について
回答  ponpon  - 05/3/13(日) 20:38 -
引用なし
パスワード
   ↑
なんてもったいぶるほどたいしたコードではありませんが、
私も初心者で、ヘルプとマクロの記録を中心に考えています。
常連さんから教えていただいたコードを自分なりに解釈し、
応用できるようにがんばっていますので・・・indy さんが
どれだけ自分で考え、コードにしているか知りたかっただけです。

これでいけると思います。

Sub test2()
　　Dim myRng As Range
　　Dim myRng2 As Range
　　Dim r As Range
　　
　　With Worksheets("sheet1")
　　　　 Set myRng = .Range(.Range("M2"), .Range("M65536").End(xlUp))
　　　　 For Each r In myRng
　　　　　 If r <> "" Then
　　　　　　 If r.Value <> r.Offset(, 1).Value Then
　　　　　　　　With Worksheets("sheet2")
　　　　　　　　　.Range("A１:B1").Value = Worksheets("sheet1") _
　　　　　　　　　　　　　　　　　.Range("A１:B1").Value
　　　　　　　　　.Range("C1:D1").Value = Worksheets("sheet1") _
　　　　　　　　　　　　　　　　 .Range("M１:N1").Value
　　　　　　　　　Set myRng2 = .Range("A65536").End(xlUp).Offset(1, 0)
　　　　　　　　　With myRng2
　　　　　　　　　　.NumberFormatLocal = "@"
　　　　　　　　　　.Resize(1, 2).Value = r.Offset(0, -12) _
　　　　　　　　　　　　　　　　　　　　　.Resize(1, 2).Value
　　　　　　　　　　.Offset(0, 2).Resize(1, 2).Value _
　　　　　　　　　　　　　　　　　　　　= r.Resize(1, 2).Value
　　　　　　　　　End With
　　　　　　　　End With
　　　　　　 End If
　　　　　 End If
　　　　 Next
　　End With

End Sub
【23113】Re:データの抽出について
お礼  indy  - 05/3/13(日) 23:38 -
引用なし
パスワード
   ponponさん
この度は本当にどうもありがとうございました。
VBAは全くの初心者です。
最初に教えて頂いたコードを参考に
次のケースをやってみたのですが、
力不足で希望通りに動かず、
助けを求めてしまいました。
一つ一つコードを研究しながら
頑張ります。
どうもありがとうございました。
【23114】Re:データの抽出について
お礼  indy  - 05/3/13(日) 23:56 -
引用なし
パスワード
   かみちゃんさん
この度はどうもありがとうございました。
二つのケースは実際依頼されており
最初に教えて頂いたコードを参考に
次は自分でやってみたのですが、
希望通りに動かず、助けを求めてしまいました。
かみちゃんさんから教えて頂いたコードを
参考にさせて頂き、違う動きに対して
応用して書けるよう頑張ります。
どうもありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10210 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free