Excel VBA質問箱 IV

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

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


10208 / 13644 ツリー ←次へ | 前へ→

【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

           ↑ここも、rからどれくらい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("A1:B1").Value = Worksheets("sheet1") _
                 .Range("A1:B1").Value
         .Range("C1:D1").Value = Worksheets("sheet1") _
                 .Range("M1: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 -

引用なし
パスワード
   かみちゃんさん
この度はどうもありがとうございました。
二つのケースは実際依頼されており
最初に教えて頂いたコードを参考に
次は自分でやってみたのですが、
希望通りに動かず、助けを求めてしまいました。
かみちゃんさんから教えて頂いたコードを
参考にさせて頂き、違う動きに対して
応用して書けるよう頑張ります。
どうもありがとうございました。

10208 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free