ここから本文です

エクセルVBAで、条件に一致すれば、特定のデータを表示し、一致しない場合は、手入...

gom********さん

2011/10/2415:44:10

エクセルVBAで、条件に一致すれば、特定のデータを表示し、一致しない場合は、手入力ができるようにする方法を教えて下さい。 (前回の続きになります)

以前お尋ねした通り表を作成することはできたのですが、
参照するセルや列を変更すると私の知識では対応できませんでした・・・

恐れ入りますが、下記の内容の場合のコードを教えて下さい。

Bがりんごで、Cが青森なら、F列に特定の商品名を表示する。
どれにも一致しなければ、F列に手入力できるようにする方法が知りたいです。

どのように変更したらよいでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim TgRng As Range
Dim FRng As Range
Dim Fst As String
Set TgRng = Intersect(Range("A2:D2").Resize(UsedRange.Rows.Count), Target)
If TgRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Rng In TgRng
If Rng.Column = 1 Then
If Not IsEmpty(Rng) And Not IsEmpty(Rng.Offset(, 1)) Then
Set FRng = Sheets("シート").Range("A:A").Find(Rng.Value, lookat:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
If Rng.Offset(, 1).Value = FRng.Offset(, 1).Value Then
Rng.Offset(, 2).Value = FRng.Offset(, 2).Value
Exit Do
End If
Set FRng = Sheets("シート").Range("A:A").FindNext(FRng)
Loop Until FRng Is Nothing Or FRng.Address = Fst
End If
Else
Rng.Offset(, 2).Value = ""
End If
ElseIf Rng.Column = 2 Then
If Not IsEmpty(Rng) And Not IsEmpty(Rng.Offset(, -1)) Then
Set FRng = Sheets("シート").Range("B:B").Find(Rng.Value, lookat:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
If Rng.Offset(, -1).Value = FRng.Offset(, -1).Value Then
Rng.Offset(, 1).Value = FRng.Offset(, 1).Value
Exit Do
End If
Set FRng = Sheets("シート").Range("A:A").FindNext(FRng)
Loop Until FRng Is Nothing Or FRng.Address = Fst
End If
Else
Rng.Offset(, 1).Value = ""
End If
End If
Next
Application.EnableEvents = True
Set FRng = Nothing
End Sub

閲覧数:
672
回答数:
1
お礼:
100枚

違反報告

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

ja7********さん

2011/10/2416:25:51

ただ列を変更しただけですね。
参照表(Sheet2)のレイアウトは、同じものとします。
こんな感じです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim TgRng As Range
Dim FRng As Range
Dim Fst As String
Set TgRng = Intersect(Range("B2:C2").Resize(UsedRange.Rows.Count), Target)
If TgRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Rng In TgRng
If Rng.Column = 2 Then ' <-- B列を変更時
If Not IsEmpty(Rng) And Not IsEmpty(Rng.Offset(, 1)) Then
Set FRng = Sheets("Sheet2").Range("A:A").Find(Rng.Value, lookat:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
If Rng.Offset(, 1).Value = FRng.Offset(, 1).Value Then
Rng.Offset(, 4).Value = FRng.Offset(, 2).Value
Exit Do
End If
Set FRng = Sheets("Sheet2").Range("A:A").FindNext(FRng)
Loop Until FRng Is Nothing Or FRng.Address = Fst
End If
Else
Rng.Offset(, 4).Value = ""
End If
ElseIf Rng.Column = 3 Then ' <-- C列を変更時
If Not IsEmpty(Rng) And Not IsEmpty(Rng.Offset(, -1)) Then
Set FRng = Sheets("Sheet2").Range("B:B").Find(Rng.Value, lookat:=xlWhole)
If Not FRng Is Nothing Then
Fst = FRng.Address
Do
If Rng.Offset(, -1).Value = FRng.Offset(, -1).Value Then
Rng.Offset(, 3).Value = FRng.Offset(, 1).Value
Exit Do
End If
Set FRng = Sheets("Sheet2").Range("A:A").FindNext(FRng)
Loop Until FRng Is Nothing Or FRng.Address = Fst
End If
Else
Rng.Offset(, 3).Value = ""
End If
End If
Next
Application.EnableEvents = True
Set FRng = Nothing
End Sub

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

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

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

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

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

閉じる

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

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

閉じる