Excel VBA質問箱 IV

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

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


1416 / 13645 ツリー ←次へ | 前へ→

【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 発言[未読]

【74591】ある列で同じデータがあったらその別の列...
質問  たえりか  - 13/8/1(木) 16:02 -

引用なし
パスワード
   たとえばA列に上からリンゴ、リンゴ、みかん、リンゴ、バナナ、みかん、リンゴと入力されていて、
B列に赤a、赤b、橙c、赤d、黄e、橙f、赤g
C列に1111、2222、3333、4444、5555、6666、7777
と入力されているとして

D1セルにリンゴと入力したら
F列に上から赤a、赤b、赤d、赤g
G列に上から1111、2222、4444、7777

と表示されるようにするにはどのようなマクロをくんだらいいでしょうか?
勉強中なのですが初心者でまったくわかりません。

(ある値を入力したらそれを別の一覧表から見つけその横の列にある値を別のセルに入力する、というのは以前してみたことがあるのですが、これは一つの値に対して複数のデータを集めてこないといけないので、知識が役に立ちませんでした。。。)
どなたかお知恵お貸しいただけますでしょうか。

【74592】Re:ある列で同じデータがあったらその別...
発言  kanabun  - 13/8/1(木) 17:29 -

引用なし
パスワード
   ▼たえりか さん:

E1セルにリンゴと入力したら

>F列に上から赤a、赤b、赤d、赤g
>G列に上から1111、2222、4444、7777
>
>と表示されるようにするにはどのようなマクロをくんだらいいでしょうか?

それはフィルターの AdvancedFilter(フィルタオプションの設定とか
詳細設定という日本語のメニューになってます) を使うといいです。

 A   B   C      E   F   G 
品名  属性  コード    品名  属性  コード
リンゴ  赤a  111     リンゴ  
リンゴ  赤b  222          
みかん  橙c  333          
リンゴ  赤d  444          
バナナ  黄e  555
みかん  橙f  666
リンゴ  赤g  777

フィルターですから一行目は列見出しにします。
以下、マクロの記録を少し編集したものです。

Sub Macro2()
'
  Range("E1").FormulaR1C1 = "品名"  'E列を抽出条件範囲にします
  Range("E2").FormulaR1C1 = "リンゴ" '1行目 [A1]の見出し 2行目 抽出品名
  Range("B1:C1").Copy Range("F1")  '[B1:C1]抽出列見出しを[F1:G1]へコピー
  'フィルターオプション実行
  Range("A1").CurrentRegion.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Range("E1:E2"), _
    CopyToRange:=Range("F1:G1")
End Sub

 A   B   C      E   F   G 
品名  属性  コード    品名  属性  コード
リンゴ  赤a  111     リンゴ  赤a  111
リンゴ  赤b  222          赤b  222
みかん  橙c  333          赤d  444
リンゴ  赤d  444          赤g  777
バナナ  黄e  555
みかん  橙f  666
リンゴ  赤g  777

【74595】Re:ある列で同じデータがあったらその別...
質問  たえりか  - 13/8/1(木) 21:25 -

引用なし
パスワード
   ▼kanabun さん:
早速のご回答ありがとうございました。
確かに教えていただいたとおりにしたら質問したことができました!

教えていただいたコードでマクロを実行するとE2には"リンゴ"と入力されます。
たとえばE2を入力規則でドロップダウンリストにして、"リンゴ"から"みかん"あるいは"バナナ"に変えたとき、F列とG列も変わるようにできないでしょうか?

また、少し話がそれて恐縮ですがC列がコードではなく、個数などの数値データだとして、
G列を基準として降順でF列とG列が自動で並べ替えられて表示される方法がありますでしょうか?

作りたいのは、E2列に表示されたアイテムがF列の場所でG列の個数販売されているとして
その円グラフを表示させたいと思っています。
E2セルのアイテム名を変えると円グラフが次々変わる、のようなものを考えています。

【74597】Re:ある列で同じデータがあったらその別...
発言  kanabun  - 13/8/1(木) 22:01 -

引用なし
パスワード
   ▼たえりか さん:
>▼kanabun さん:
>早速のご回答ありがとうございました。
>確かに教えていただいたとおりにしたら質問したことができました!
>
>教えていただいたコードでマクロを実行するとE2には"リンゴ"と入力されます。
>たとえばE2を入力規則でドロップダウンリストにして、"リンゴ"から"みかん"あるいは"バナナ"に変えたとき、F列とG列も変わるようにできないでしょうか?

そのばあいは、マクロを標準モジュールにではなく、
対象ワークシートモジュールに書きます。
[E2] に {リンゴ,みかん,バナナ} の入力規則を設定しておき、

そのシートのモジュールに こんな感じです。

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) <> "E2" Then Exit Sub
  
  Application.EnableEvents = False '-----------(1)
  Range("B1:C1").Copy Range("F1")  '-----------(2)
  Range("A1").CurrentRegion.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Range("E1:E2"), _
    CopyToRange:=Range("F1:G1")      '------- (3)
  Application.EnableEvents = True      '------- (4)

End Sub

(1) セルを書き換えますので、Changeイベントがまた起きます。
  そうすると また Worksheet_Change イベントが起き、イベントの
  連鎖が発生し、困ったことになりますので、これ以後、セルを書き換えても
  Changeイベントは発生しなかったことにします。
(2) [B1:C1]の列見出しを [[F1:G1](出力列)にコピーします。
  [C1] が「数量」なら、[G1]も「数量」に変わります。
(3) フィルタオプションを実行します。
   条件範囲[E1:E2]
   抽出先 [F1:G1]
(4) 抽出転記が終われば、次のセル変化に対応するために、
  EnableEventsプロパティを 「有効」に戻しておきます。


>また、少し話がそれて恐縮ですがC列がコードではなく、個数などの数値データだとして、
>G列を基準として降順でF列とG列が自動で並べ替えられて表示される方法がありますでしょうか?
そうするには、さっきのコードの (3) のあとに 追加します。

  Application.EnableEvents = False
  Range("B1:C1").Copy Range("F1")
  Range("A1").CurrentRegion.AdvancedFilter _
     Action:=xlFilterCopy, _
     CriteriaRange:=Range("E1:E2"), _
     CopyToRange:=Range("F1:G1")
  '------------------------------------------------------- ここから
  Dim r As Range
  Set r = Range("F1", Cells(Rows.Count, "F").End(xlUp)) _
      .Resize(, 2)
  If r.Rows.Count > 2 Then
    r.Sort Key1:=r.Columns(2), Header:=xlYes
  End If
  '------------------------------------------------------- ここまで  
  Application.EnableEvents = True

【74599】Re:ある列で同じデータがあったらその別...
質問  たえりか  - 13/8/2(金) 10:17 -

引用なし
パスワード
   ありがとうございます。すごい!これが求めてたものです!

何度も申し訳ないですが、もう少し教えてください。
教えていただいたのを参考に、応用して下記コードを書いてみようと思ったのですがうまく動きません。
Sheet1に下記のような元のデータがあるとして(A~C列やE~G列、I列は見たいデータではないので省略)

D列    H列    J列
品名    属性    値
リンゴ    赤a    111
リンゴ    赤b    222
みかん    橙c    333
リンゴ    赤d    444
バナナ    黄e    555
みかん    橙f    666
リンゴ    赤g    777

Sheet2のA1に”品名”、A2セルに入力規則を設定し選択するセルにする。
G5セルに”属性”、H5セルに”値”
G6:H6以下に取り出したデータ
が出るようにしようと思い下記のように書いてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
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
 
  Application.EnableEvents = False 

  ws1.Range("H2:J2").Copy ws2.Range("G5")  ‘もう面倒なのでH2~J2列までまとめてコピーして貼り付けてしまいました。
  
  ws1.Range("D2").CurrentRegion.AdvancedFilter _ 
    Action:=xlFilterCopy, _
    CriteriaRange:=ws2.Range("A1:A2"), _  ‘クライテリアはSheet2のA1:A2です。
    CopyToRange:=ws2.Range("G5:I5")   ‘G5:I5以下にSheet1のH2:J2列以下のフィルタかけた値を書き出す。 
  
  Application.EnableEvents = True      

End Sub

これだと、Sheet2のA2セルを変更してもまったく何も起こりません。
どうしてでしょうか?

お手数ですが教えてください。

【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

【74601】Re:ある列で同じデータがあったらその別...
発言  kanabun  - 13/8/2(金) 11:32 -

引用なし
パスワード
   あ、ごめん

> (A~C列やE~G列、I列は見たいデータではないので省略)

って書いてありますね。A〜Jまで ひとつの連続データ(表)とみなして
いいですね。
ここは、了解です。

【74621】Re:ある列で同じデータがあったらその別...
お礼  たえりか  - 13/8/9(金) 12:45 -

引用なし
パスワード
   ご連絡が遅れ大変申し訳ございませんでした!
教えていただいた方法でどうしてもうまくいかなくて、
一度必要な行だけをコピーして別のシートに貼り付けてそれを参照したらうまくいきました。
どうしてでしょう、元のデータがほかのシートからのリンクされた情報だったからですかね。。

とにかくうまくいきました!
ありがとございました!

【74622】Re:ある列で同じデータがあったらその別...
発言  kanabun  - 13/8/9(金) 14:49 -

引用なし
パスワード
   ▼たえりか さん:

>教えていただいた方法でどうしてもうまくいかなくて、
>一度必要な行だけをコピーして別のシートに貼り付けてそれを参照したらうまくいきました。
>どうしてでしょう、元のデータがほかのシートからのリンクされた情報だったからですかね。。

リンクデータだったからではないと思います。
よろしければ、最終的に(実際に)どのようなコードでトライしたのか
教えてください。

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