ここから本文です

VBAのオートフィルタに関して

kur********さん

2019/6/2608:27:19

VBAのオートフィルタに関して

sheet1に色、形、重さが書かれた一覧表があり
sheet2に毎月頂くデータとして色、形、重さ、価格が書かれた表があります。

sheet1とsheet2それぞれ色、形、重さでフィルタをかけ
この3つが一致する箇所(sheet1)に価格を入力するようにプログラムを組みたいのですがいいがしたらよろしいでしょうか。

フィルタに関して、色、形、重さ全通り組み合わせ価格の貼り付けをすることで自動化したいです。

特に全通り組み合わせる部分で悩んでいます。
宜しくお願い致します。

閲覧数:
22
回答数:
4
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

tra********さん

2019/6/2700:21:59

>特に全通り組み合わせる部分
というのはどういう意味ですかね?良く解らないですね。

Sheet2は、色、形、重さで重複はないのですよね?
であれば、SUMIFSで価格を合計すればいいのでは?
あとは、
1)SUMIFSを式で埋め込んで、式を消す
2)SUMIFSをWorkSheetFunctionから起動する
の二者択一ですね。

1)の例文です。
どちらのシートもA1から表が始まり、1行目は項目名。
A~D列に、色、形、重さ、価格が入るものとします。

Sub sample()
Const cFormula As String = _
"=SUMIFS(Sheet2!D:D,Sheet2!A:A,A2,Sheet2!B:B,B2,Sheet2!C:C,C2)"

With Worksheets("Sheet1")
With .Range("D2:D" & .Cells(Rows.Count, 1).End(xlUp).Row)
.Formula = cFormula
.Value = .Value
End With
End With
End Sub

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜3件/3件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

hot********さん

2019/6/2621:27:21

もしSheet1に色、形、重さが無かった場合は追加します。

Sub sample()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim r As Long
'
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lastRow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row 'Sheet1のA列最終行
lastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row 'Sheet2のA列最終行
For r = 2 To lastRow2 '注目行を2行目からSheet2のA列最終行まで
ws1.AutoFilterMode = False 'Sheet1のオートフィルタ解除
ws1.Range("A1:D" & lastRow1).AutoFilter Field:=1, Criteria1:=ws2.Range("A" & r).Value 'Sheet1のA列をSheet2のA列注目行の値でオートフィルタ
ws1.Range("A1:D" & lastRow1).AutoFilter Field:=2, Criteria1:=ws2.Range("B" & r).Value 'Sheet1のA列をSheet2のB列注目行の値でオートフィルタ
ws1.Range("A1:D" & lastRow1).AutoFilter Field:=3, Criteria1:=ws2.Range("C" & r).Value 'Sheet1のA列をSheet2のC列注目行の値でオートフィルタ
If WorksheetFunction.Subtotal(3, ws1.Range("A2:A" & lastRow1)) = 0 Then 'Sheet1のA2から下の表示データが0(オートフィルタの結果が0)なら
lastRow1 = lastRow1 + 1 '(追加するので)Sheet1の最終行+1
ws1.Range("A" & lastRow1, "D" & lastRow1).Value = ws2.Range("A" & r, "D" & r).Value '新しい最終行にSheet2の注目行の値を設定
Else 'あったら
ws1.Range("D2:D" & lastRow1).SpecialCells(xlCellTypeVisible).Value = ws2.Range("D" & r).Value 'Sheet1の2行目から下で表示している行(オートフィルタで表示している行)のD列にSheet2の注目行の値を設定
End If
Next
ws1.AutoFilterMode = False 'Sheet1のオートフィルタ解除
End Sub

もしSheet1に色、形、重さが無かった場合は追加します。

Sub sample()
Dim ws1 As...

web********さん

2019/6/2611:20:37

フィルタを掛けて抽出する必要があるのでしょうか?

色 & 形 & 重さ とデータ自体をつなぎ合わせた列を作ってVLOOKUPで抽出可能なんでは?

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

プロフィール画像

カテゴリマスター

aka********さん

2019/6/2610:34:32

オートフィルターではなく フィルターの詳細設定で 条件範囲を設定 入力するようにして置き

条件を入力後 マクロで 実行すれば 一致したものを表示します。

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる