VBA：3つのファイルを使用した複合処理

前提・実現したいこと

ExcelのユーザーフォームでVBAを使用し、3つのファイルを照合し処理条件に当てはまった場合に背景色を緑にしたい
![]

■条件
ComboBox1で①が選択されている
かつ
TextBox4が空白の場合
または
上記に一致しない場合

■処理
CommandButton1で選択したファイルの左から5番目のシートをsheet1とし取り込む
その際に文字列を数値に変換し、TextBox3にファイル格納先を表示

CommandButton2で選択したファイルの1番左のシートをsheet2とし取り込む
その際にTextBox4にファイル格納先を表示

CommandButton4で選択したファイルの1番左のシートをsheet3とし取り込む
その際にTextBox6にファイル格納先を表示
※ここはファイル選択必須ではないです

上記で各ファイルを選択後にCommandButton3（処理実行ボタン）を押下

■条件に記載した
ComboBox1で①が選択されている
かつ
TextBox6が空白の場合
の場合は
Sub 重複は色付け_①の処理：Sheet1のE列で同じ会員番号があった場合に背景色を赤色（対象セルのみ）
Sub ●●以外_①の処理：Sheet2に会員番号がないが、Sheet1にはあった場合にSheet1　E列の背景色を青色（対象セルのみ）
の2つを処理する

↑
ここまでは自分でも対応できました

下記で困っています
↓

■条件に記載した
上記に一致しない
の場合、上記2つの処理にもう1つ処理を追加し3つの処理をしたくその内容が
sheet3に会員番号がないが、Sheet1にはあり
かつ
sheet2にもある場合にSheet1　E列の背景色を緑色（対象セルのみ）
にしたい

該当のソースコード

※ComboBox1の選択肢で②がありますが、現状は使用しないためスルーでお願いします

VBA
1Private Sub ComboBox1_Change()
2
3    With ComboBox1
4    
5    Select Case .Value
6        Case "①": .FontBold = False: .ForeColor = RGB(0, 0, 0)
7        Case "②": .FontBold = False: .ForeColor = RGB(0, 0, 0)
8    End Select
9    
10    End With
11
12
13End Sub
14
15Private Sub CommandButton1_Click()
16    
17    Dim filePath As Variant
18    filePath = Application.GetOpenFilename
19    
20    Dim wb As Workbook: Set wb = ThisWorkbook
21    Dim wb1 As Workbook
22    
23If ComboBox1 = "①" Then
24        
25    On Error Resume Next
26    Set wb1 = Workbooks.Open(filePath)
27    Application.Visible = False
28        wb1.Activate
29        wb1.Worksheets(5).Move Before:=wb.Worksheets(1)
30        wb.Activate
31        wb.Worksheets(1).Select
32        Worksheets(1).Name = "sheet1"
33    Dim colcnt  As Integer
34 
35        '全列文字列で保存されている数値を数値に変換
36        colcnt = 1
37        While Cells(1, colcnt) <> ""
38            Columns(colcnt).TextToColumns Comma:=True
39            colcnt = colcnt + 1
40        Wend
41        
42    On Error GoTo 0
43        If filePath = False Then
44    Exit Sub
45        Else
46           TextBox3.Value = filePath
47        End If
48    Exit Sub
49    
50ElseIf ComboBox1 = "②" Then
51
52    On Error Resume Next
53    Set wb1 = Workbooks.Open(filePath)
54    Application.Visible = False
55        wb1.Activate
56        wb1.Worksheets(1).Move Before:=wb.Worksheets(1)
57        wb.Activate
58        wb.Worksheets(1).Select
59        Worksheets(1).Name = "sheet1"
60    On Error GoTo 0
61        If filePath = False Then
62    Exit Sub
63        Else
64           TextBox3.Value = filePath
65        End If
66    Exit Sub
67            
68        End If
69        
70End Sub
71
72Private Sub CommandButton2_Click()
73
74    
75    Dim filePath As Variant
76    filePath = Application.GetOpenFilename
77    
78    Dim wb As Workbook: Set wb = ThisWorkbook
79    Dim wb1 As Workbook
80    
81    On Error Resume Next
82    Set wb1 = Workbooks.Open(filePath)
83    Application.Visible = False
84        wb1.Activate
85        wb1.Worksheets(1).Move Before:=wb.Worksheets(2)
86        wb.Activate
87        wb.Worksheets(2).Select
88        Worksheets(2).Name = "sheet2"
89    On Error GoTo 0
90        If filePath = False Then
91    Exit Sub
92        Else
93            TextBox4.Value = filePath
94        End If
95    Exit Sub
96    
97    
98End Sub
99
100Private Sub CommandButton3_Click()
101
102    Dim myFile As String
103    myFile = TextBox3.Text
104
105    If myFile = "" Then
106        MsgBox ("ファイルを選択してください")
107    Exit Sub
108    End If
109
110    Application.ScreenUpdating = False
111               
112                   
113        If ComboBox1 = "①" And TextBox6 = "" Then
114            Call 重複は色付け_①(True)
115            Call ●●以外_①(False)
116        Else
117            Call 重複は色付け_①(True)
118            Call ●●以外_①(False)
119            Call 新たに対応したい_①(False)
120        End If
121        
122        Worksheets(1).Name = TextBox5 & "_" & TextBox1 & "_" & TextBox2 & "_①照合結果"
123    Application.ScreenUpdating = True
124    Call 指定したシート以外の削除
125    Call 開いたフォルダへ保存
126    Application.Quit
127    Workbooks.Close
128    
129End Sub
130
131Private Sub CommandButton4_Click()
132
133    
134    Dim filePath As Variant
135    filePath = Application.GetOpenFilename
136    
137    Dim wb As Workbook: Set wb = ThisWorkbook
138    Dim wb1 As Workbook
139    
140    On Error Resume Next
141    Set wb1 = Workbooks.Open(filePath)
142    Application.Visible = False
143        wb1.Activate
144        wb1.Worksheets(1).Move Before:=wb.Worksheets(3)
145        wb.Activate
146        wb.Worksheets(3).Select
147        Worksheets(3).Name = "sheet3"
148    On Error GoTo 0
149        If filePath = False Then
150    Exit Sub
151        Else
152            TextBox6.Value = filePath
153        End If
154    Exit Sub
155    
156    
157End Sub
158
159Sub 重複は色付け_①(ByVal clear_flag As Boolean)
160    Dim sh1 As Worksheet
161    Dim maxrow As Long
162    Dim wrow As Long
163    Dim dicT As Object
164    Dim key As String
165    Set dicT = CreateObject("Scripting.Dictionary")
166    Set sh1 = Worksheets("Sheet1")
167    maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row  'Sheet1 E列最大行
168    If clear_flag = True Then
169        sh1.Range("E2:E" & maxrow).Interior.Pattern = xlNone
170    End If
171    For wrow = 2 To maxrow
172        key = sh1.Cells(wrow, "E").Value
173        If dicT.exists(key) = False Then
174            dicT(key) = True
175        Else
176            sh1.Cells(wrow, "E").Interior.Color = RGB(255, 0, 0)    'E列の該当セルは背景を赤色
177        End If
178    Next
179End Sub
180
181Sub ●●以外_①(ByVal clear_flag As Boolean)
182    Dim x As Long
183    Dim i As Long
184
185    With Sheets("Sheet1")
186        x = .UsedRange.Cells(.UsedRange.Count).Row
187        If clear_flag = True Then
188            .Range("E2:E" & x).Interior.Pattern = xlNone
189        End If
190        For i = x To 2 Step -1
191            If Sheets("Sheet2").Range("A:A").Find(What:=.Cells(i, 5), LookAt:=xlWhole) Is Nothing Then '一致しない
192                .Cells(i, 5).Interior.Color = RGB(0, 0, 255) 'E列の背景を青色に
193            End If
194        Next i
195    End With
196End Sub
197
198Sub 新たに対応したい_①(ByVal clear_flag As Boolean)
199
200　　ここの処理コードが分からず困っています
201
202End Sub
203
204Sub 開いたフォルダへ保存()
205    Dim thisPath As String
206    thisPath = ThisWorkbook.Path
207    ThisWorkbook.SaveAs Filename:=thisPath & "\" & TextBox5 & "_" & TextBox1 & "_" & TextBox2 & "_①照合結果", FileFormat:=xlWorkbookDefault
208End Sub
209
210Sub 指定したシート以外の削除()
211  Dim Sh As Worksheet
212    For Each Sh In Sheets
213      If Not (Sh.Name = TextBox5 & "_" & TextBox1 & "_" & TextBox2 & "_①照合結果") Then
214      Application.DisplayAlerts = False
215      Sh.Delete
216      Application.DisplayAlerts = True
217    End If
218  Next
219End Sub
220
221Private Sub TextBox1_Change()
222
223End Sub
224
225Private Sub TextBox2_Change()
226
227End Sub
228
229Private Sub TextBox3_Change()
230
231End Sub
232
233Private Sub TextBox4_Change()
234
235End Sub
236
237Private Sub TextBox5_Change()
238
239End Sub
240
241Private Sub TextBox6_Change()
242
243End Sub
244
245Private Sub UserForm_Terminate()
246    MsgBox "画面を閉じます。"
247    Application.Visible = True
248    Application.Quit
249    Workbooks.Close
250End Sub
251
252Private Sub UserForm_Initialize()
253
254    ComboBox1.AddItem ""
255    ComboBox1.AddItem "①"
256    'ComboBox1.AddItem "②"
257    ComboBox1.ListIndex = 0
258    Application.Visible = False
259
260End Sub
261

困っている事

3ファイル同時の照合処理が調べても中々出てこず、対応ができないでいるため助けていただけますと幸いです。

行動規範の内容に同意します

回答1件

ベストアンサー

sheet3に会員番号がないが、Sheet1にはあり

かつ
sheet2にもある場合にSheet1　E列の背景色を緑色（対象セルのみ）
にしたい

「かつ」なのでAnd条件ですね。2つの条件式をAnd演算子で繋げればいいでしょう。

vba
1Sub 新たに対応したい_①(ByVal clear_flag As Boolean)
2    Dim x As Long
3    Dim i As Long
4
5    With Sheets("Sheet1")
6        x = .UsedRange.Cells(.UsedRange.Count).row
7        If clear_flag = True Then
8            .Range("E2:E" & x).Interior.Pattern = xlNone
9        End If
10        For i = x To 2 Step -1
11            If Sheets("Sheet3").Range("A:A").Find(What:=.Cells(i, 5), LookAt:=xlWhole) Is Nothing _
12              And Not Sheets("Sheet2").Range("A:A").Find(What:=.Cells(i, 5), LookAt:=xlWhole) Is Nothing _
13                Then
14                .Cells(i, 5).Interior.Color = RGB(0, 255, 0) 'E列の背景を青色に
15            End If
16        Next i
17    End With
18
19End Sub