Excel VBA質問箱 IV

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

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


7719 / 76734 ←次へ | 前へ→

【74600】Re:ある列で同じデータがあったらその別の列のデータを取り出す
発言  kanabun  - 13/8/2(金) 11:15 -

引用なし
パスワード
   ▼たえりか さん:
>ありがとうございます。すごい!これが求めてたものです!
>
>何度も申し訳ないですが、もう少し教えてください。
>教えていただいたのを参考に、応用して下記コードを書いてみようと思ったのですがうまく動きません。
>Sheet1に下記のような元のデータがあるとして(A~C列やE~G列、I列は見たいデータではないので省略)
>
>D列    H列    J列
>品名    属性    値
>リンゴ    赤a    111
>リンゴ    赤b    222
>みかん    橙c    333
>リンゴ    赤d    444
>バナナ    黄e    555
>みかん    橙f    666
>リンゴ    赤g    777
>
質問:表のA,B,C列 など ↑に書いてない列はどうなっているのでしょう?
データは
>D列    H列    J列
同様、実際はあるとみなしていいでしょうか?

>Sheet2のA1に”品名”、A2セルに入力規則を設定し選択するセルにする。
OK です。

>G5セルに”属性”、H5セルに”値”
列見出しは 元データと連動したほうがいいから、あとで実例をお見せしますが
数式で参照したほうが写し間違いが生じなくていいですよ。

>G6:H6以下に取り出したデータ
>が出るようにしようと思い下記のように書いてみました。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
確認:このプロシージャは [Sheet2] に書いていますよね
  Sheet2 に書いていれば、 Sheet2 が Me です。
  そして Me は省略できますから、 Me.Range("A1:A2") は
  たんに Range("A1:A2") でいいです。

>Dim ws1 As Worksheet, ws2 As Worksheet
>
>Set ws1 = Worksheets("Sheet1")
>Set ws2 = Worksheets("Sheet2")
>
>  If Target.Address(0, 0) <> ws2.Range("A2") Then Exit Sub
   ↑ここが第1のまちがい
 Target.Address(0, 0) とは 値変化したセルの「アドレス」のことです。
 ws2.Range("A2")  というのは Rangeオブジェクトのことです。
 双方の「型が違います」。 比較できてません。 

> 
>  Application.EnableEvents = False 
>
>  ws1.Range("H2:J2").Copy ws2.Range("G5")  ‘もう面倒なのでH2~J2列までまとめてコピーして貼り付けてしまいました。
まちがいです。
ws1の2行目はデータです。 ws1 の [H1:J1]を貼り付けてください。

>  
>  ws1.Range("D2").CurrentRegion.AdvancedFilter _ 
>    Action:=xlFilterCopy, _
>    CriteriaRange:=ws2.Range("A1:A2"), _  ‘クライテリアはSheet2のA1:A2です。
  ws1.Range("D2").CurrentRegion で ws1のE,F,G列と I列にもデータが
  入っていないと(少なくとも1行目に列見出しが入ってないと)
  「属性」列、「値」列がCurrentRegion に含まれないことになるので
  注意してください。

あとは OK のようです♪

>    CopyToRange:=ws2.Range("G5:I5")   ‘G5:I5以下にSheet1のH2:J2列以下のフィルタかけた値を書き出す。 
>  
>  Application.EnableEvents = True      
>
>End Sub

参考までに 「属性」「値」だけ抽出転記するSheet2のイベントコードを
つけておきます。

'以下は [Sheet2]のモジュールコードです.
Private Sub Worksheet_Change(ByVal Target As Range)
  '変更のあったセル名が[A2]でなければ抜ける
  If Target.Address(0, 0) <> "A2" Then Exit Sub
  
  Dim ws1 As Worksheet
  Set ws1 = Worksheets(1)
  Application.EnableEvents = False
  '-----Sheet2の[G5:H5]にSheet1の[H1,J1]列見出しをCopy
  [G5].Formula = "=" & ws1.Name & "!H1"
  [H5].Formula = "=" & ws1.Name & "!J1"
  'フィルタによる「属性」「値」データの抽出転記
  ws1.[A1].CurrentRegion.AdvancedFilter _
     Action:=xlFilterCopy, _
     CriteriaRange:=[A1:A2], _
     CopyToRange:=[G5:H5]
  Dim r As Range
  Set r = Range("G5", Cells(Rows.Count, "G").End(xlUp)) _
      .Resize(, 2)
  If r.Rows.Count > 2 Then
    r.Sort Key1:=r.Columns(2), Header:=xlYes
  End If

  Application.EnableEvents = True
End Sub
14 hits

【74591】ある列で同じデータがあったらその別の列のデータを取り出す たえりか 13/8/1(木) 16:02 質問
【74592】Re:ある列で同じデータがあったらその別の... kanabun 13/8/1(木) 17:29 発言
【74595】Re:ある列で同じデータがあったらその別の... たえりか 13/8/1(木) 21:25 質問
【74597】Re:ある列で同じデータがあったらその別の... kanabun 13/8/1(木) 22:01 発言
【74599】Re:ある列で同じデータがあったらその別の... たえりか 13/8/2(金) 10:17 質問
【74600】Re:ある列で同じデータがあったらその別の... kanabun 13/8/2(金) 11:15 発言
【74601】Re:ある列で同じデータがあったらその別の... kanabun 13/8/2(金) 11:32 発言
【74621】Re:ある列で同じデータがあったらその別の... たえりか 13/8/9(金) 12:45 お礼
【74622】Re:ある列で同じデータがあったらその別の... kanabun 13/8/9(金) 14:49 発言

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