〖VBA〗IFを使用して1つの条件に対して複数処理をしたい

Question

前提・実現したいこと

ユーザーフォームの処理ボタンを押下した際に、条件に応じて複数処理をしたいです。

【条件1】
コンボボックスで　設問3_アンケート　が選択されている場合
Callを使用し　会員の重複_設問3　と　会員以外の回答者_設問3　の処理を実施

【条件2】
コンボボックスで　設問5_アンケート　が選択されている場合
Callを使用し　会員の重複_設問5　と　会員以外の回答者_設問5　の処理を実施

発生している問題・エラーメッセージ

エラーはないですが、各設問の処理に対して　会員以外の回答者　しか処理がされず
会員の重複　が処理されず困っております。

該当のソースコード

Private Sub CommandButton4_Click()

    Application.ScreenUpdating = False
               
        If ComboBox1 = "設問3_アンケート" Then
            Call 会員の重複_設問3
            Call 会員以外の回答者_設問3
        ElseIf ComboBox1 = "設問5_アンケート" Then
            Call 会員の重複_設問5
            Call 会員以外の回答者_設問5
        End If
        
        Worksheets(1).Name = "照合結果"

    Application.ScreenUpdating = True
    
End Sub

設問5も下記と同様のコードですが、E列の部分がG列になります。

Sub 会員の重複_設問3() 
    Dim sh1 As Worksheet
    Dim maxrow As Long
    Dim wrow As Long
    Dim dicT As Object
    Dim key As String
    Set dicT = CreateObject("Scripting.Dictionary")
    Set sh1 = Worksheets("Sheet1")
    maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row  'Sheet1 E列最大行
    sh1.Range("E2:E" & maxrow).Interior.Pattern = xlNone
    For wrow = 2 To maxrow
        key = sh1.Cells(wrow, "E").Value
        If dicT.exists(key) = False Then
            dicT(key) = True
        Else
            Cells(wrow, "E").Interior.Color = RGB(255, 0, 0)    'E列の該当セルは背景を赤色
        End If
    Next
End Sub

こちらも設問5も下記と同様のコードですが、E列の部分がG列になります。

Sub 会員以外の回答者_設問3()
    Dim x As Long
    Dim i As Long

    With Sheets("Sheet1")
        x = .UsedRange.Cells(.UsedRange.Count).Row
        .Range("E2:E" & x).Interior.Pattern = xlNone
        For i = x To 2 Step -1
            If Sheets("Sheet2").Range("A:A").Find(What:=.Cells(i, 5), LookAt:=xlWhole) Is Nothing Then '一致しない
                .Cells(i, 5).Interior.Color = RGB(0, 0, 255) 'E列の背景を青色に
            End If
        Next i
    End With
End Sub

補足情報（FW/ツールのバージョンなど）

Office 2019を使用しています。

Comments

[meg_]

デバッグはされましたか？(会員の重複_設問3() の中の動きを1行ずつ追ってみると原因が分かるのではないでしょうか？)

[退会済みユーザー]

各プロシージャ名ごとでは問題なく処理されます。

そのためCommandButton4_Clickのプロシージャ名で
まとめて処理する際に問題があるかと思っていました。
何か原因お分かりでしたらご教授いただけないでしょうか。

Answer 1

1案ですが、各プロシージャを呼び出すとき、列のクリアを行うか否かを指定するようにします。
最初に呼び出すプロシージャはクリアしないといけないので、以下のようになります。
Call 会員の重複_設問3(True)
Call 会員以外の回答者_設問3(False)
各プロシージャでは、クリアが指定された場合（trueの場合）のみ、クリアするようにします。
設問5も同様にします。
尚、Sub 会員の重複_設問3の
Cells(wrow, "E").Interior.Color = RGB(255, 0, 0) 　は
sh1.Cells(wrow, "E").Interior.Color = RGB(255, 0, 0)
に変更しておきました。
（現在表示されているシートのE列に着色してしまう為、明示的にSheet1のE列に着色するようにしました）
設問5のプロシージャも同様に変更してください。

Private Sub CommandButton4_Click()

    Application.ScreenUpdating = False

        If ComboBox1 = "設問3_アンケート" Then
            Call 会員の重複_設問3(True)
            Call 会員以外の回答者_設問3(False)
        ElseIf ComboBox1 = "設問5_アンケート" Then
            Call 会員の重複_設問5(True)
            Call 会員以外の回答者_設問5(False)
        End If

        Worksheets(1).Name = "照合結果"

    Application.ScreenUpdating = True

End Sub

Sub 会員の重複_設問3(ByVal clear_flag As Boolean)
    Dim sh1 As Worksheet
    Dim maxrow As Long
    Dim wrow As Long
    Dim dicT As Object
    Dim key As String
    Set dicT = CreateObject("Scripting.Dictionary")
    Set sh1 = Worksheets("Sheet1")
    maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).row  'Sheet1 E列最大行
    If clear_flag = True Then
        sh1.Range("E2:E" & maxrow).Interior.Pattern = xlNone
    End If
    For wrow = 2 To maxrow
        key = sh1.Cells(wrow, "E").Value
        If dicT.exists(key) = False Then
            dicT(key) = True
        Else
            sh1.Cells(wrow, "E").Interior.Color = RGB(255, 0, 0)    'E列の該当セルは背景を赤色
        End If
    Next
End Sub

Sub 会員以外の回答者_設問3(ByVal clear_flag As Boolean)
    Dim x As Long
    Dim i As Long

    With Sheets("Sheet1")
        x = .UsedRange.Cells(.UsedRange.Count).row
        If clear_flag = True Then
            .Range("E2:E" & x).Interior.Pattern = xlNone
        End If
        For i = x To 2 Step -1
            If Sheets("Sheet2").Range("A:A").Find(What:=.Cells(i, 5), LookAt:=xlWhole) Is Nothing Then '一致しない
                .Cells(i, 5).Interior.Color = RGB(0, 0, 255) 'E列の背景を青色に
            End If
        Next i
    End With
End Sub

Comments

[退会済みユーザー]

回答ありがとうございます。

回答いただいた内容で問題なく処理ができました。

Answer 2

今回の件の場合、プロシージャを2つに分けたとこが問題かも？

んと。。。
会員の重複
とか
会員以外の回答者
とかといっても、
どうなっているときにそう判断できるかがわかりません。

おそらく、

もし、あるセルの値が、
同じ列の中に1個より多ければ、重複（＝赤く塗りつぶす）
そうでなければ、さらにA列を見て0個なら非会員（青く塗りつぶす）
いずれでもなければ何もしない

ということをやりたいのだとしたら、
一連で考えた方が簡単では？

Option Explicit

Dim mrngTable As Range

Private Sub UserForm_Initialize()
    Set mrngTable = ThisWorkbook.Worksheets(1).UsedRange
    
    With Me.ComboBox1
        .AddItem "設問3"
        .AddItem "設問5"
    End With
End Sub

Private Sub CommandButton1_Click()
    Dim ixCol As Variant
    
    Select Case Me.ComboBox1.Value
        Case "設問3": ixCol = "E"
        Case "設問5": ixCol = "G"
    End Select
    
    注意データ強調 ixCol
End Sub

Private Sub 注意データ強調(ByVal ixCol As Variant)
    Dim Rng As Range
    Dim ixColor As Long
    
    With mrngTable
        Set Rng = Intersect(.Cells, .Offset(1), .Columns(ixCol))
    End With
    
    Rng.Interior.Color = xlNone
    
    With Application.WorksheetFunction
        For Each c In Rng
            If .CountIf(Rng, c) > 1 Then
                ixColor = vbRed
            ElseIf .CountIf(mrngTable.Columns(1), c) = 0 Then
                ixColor = vbBlue
            Else
                ixColor = xlNone
            End If
            
            If ixColor > -1 Then
                c.Interior.Color = ixColor
            End If
        Next
    End With
End Sub

CountIf関数で処理速度が不満なら、
その時に、それに代わる関数を自作したら
よいかと思います。

※動作確認は行っていません。
処理の流れのイメージを再確認してください。

Answer 3

設問の以下処理で、せっかく重複の処理で赤色にした背景が消されてますね。

.Range("E2:E" & x).Interior.Pattern = xlNone

なので、処理はされてますよ。多分。

Comments

[退会済みユーザー]

ご回答ありがとうございます。

原因理解しました。
大変恐縮ですが、こちら同時に処理する事は可能でしょうか？

[退会済みユーザー]

プロシージャを分ける必要がないなら
if ～
重複の処理
else if ～
設問の処理

でルーチンまとめるとか。

プロシージャを分ける必要があるすると、
.Range("E2:E" & x).Interior.Pattern = xlNone　これが必要であるかによります。

現状の流れを汲めば、
重複の Interior.Pattern = xlNone を残して、
設問の Interior.Pattern = xlNone を消すとか。

この場合、設問プロシージャが個別に必要な場面があれば適切でないです。

上記で実現できそうになければ、要件を提示下さい。

[退会済みユーザー]

もしくは、.Range("E2:E" & x).Interior.Pattern = xlNone が必要な局面が限られるのであれば、
この処理だけをサブルーチンにしては如何でしょう。引数で列なり行なり指定できますし。

今回の場合、
call 上述のサブルーチン
call 重複（背景クリアを除く）
call 設問（背景クリアを除く）
の流れで処理できるようになります。

[退会済みユーザー]

ご丁寧にありがとうございます。

今後の参考に致します。