|
こんばんは。
今日は、常連さんの参加が少ないですね。
>たとえば男であるまたは1組であるとか。
ここの条件が具体的でないので、よくわかりませんが・・・
もっと良い方法があるかもしれませんが、
こんな感じでは、どうでしょう?
1組、2組・・の数字は全角です。
また、色は適当です。
Sub test()
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim myR As Range
Dim r As Range
Dim FR As Variant
Dim myNO As Integer
Application.ScreenUpdating = False
Set SH1 = Worksheets("Sheet1")
Set SH2 = Worksheets("Sheet2")
Set myR = SH1.Range("A1:B4")
myR.Interior.ColorIndex = xlNone
For Each r In myR
FR = Application.Match(r.Value, SH2.Range("C:C"), 0)
If IsError(FR) = False Then
Select Case True
Case SH2.Cells(FR, 1) = "男" And SH2.Cells(FR, 2) = "1組"
myNO = 3
Case SH2.Cells(FR, 1) = "男" And SH2.Cells(FR, 2) = "2組"
myNO = 6
Case SH2.Cells(FR, 1) = "男" And SH2.Cells(FR, 2) = "3組"
myNO = 4
Case SH2.Cells(FR, 1) = "女" And SH2.Cells(FR, 2) = "1組"
myNO = 15
Case SH2.Cells(FR, 1) = "女" And SH2.Cells(FR, 2) = "2組"
myNO = 24
Case SH2.Cells(FR, 1) = "女" And SH2.Cells(FR, 2) = "3組"
myNO = 38
End Select
r.Interior.ColorIndex = myNO
Else
MsgBox "この人の名前はありません。" & vbCrLf _
& "セル番号:" & r.Address(0, 0)
End If
Next
Application.ScreenUpdating = True
Set myR = Nothing: Set SH1 = Nothing: Set SH2 = Nothing
End Sub
|
|