新增一個相同的IF判別式，執行結果和修改前一樣？

av8d

修改前

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim Rng As Range, I As Integer
   
3.   With Target
   
4.     '.Select   '多一次確認
   
5.     If .Column = 4 Or .Column = 12 Then
   
6.         If Cells(.Row, 4) <> "" And Cells(.Row, 12) <> "" Then
   
7.             For I = 1 To Cells(Rows.Count, .Column).End(xlUp).Row
   
8.                 If Cells(I, 4) = Cells(.Row, 4) And Cells(I, 12) = Cells(.Row, 12) And I <> .Row Then
   
9.                     If Rng Is Nothing Then
   
10.                         Set Rng = Union(Cells(I, 4), Cells(I, 12))
    
11.                     Else
    
12.                         Set Rng = Union(Rng, Cells(I, 4), Cells(I, 12))
    
13.                     End If
    
14.                 End If
    
15.             Next
    
16.             If Not Rng Is Nothing Then
    
17.                 Set Rng = Union(Rng, Cells(.Row, 4), Cells(.Row, 12))
    
18.                 Rng.Select
    
19.                 'MsgBox Cells(.Row, 4) & vbNewLine & Cells(.Row, 12) & vbNewLine & "出現重複 "
    
20.                 UserForm2.Show
    
21.             End If
    
22.         End If
    
23.     End If
    
24.   End With
    
25.   
    
26.     If Target.Cells.Count > 1 Then Exit Sub
    
27.         If Union(Target, [K:K]).Address <> [K:K].Address Then Exit Sub
    
28.         If Target = "紅色" Then
    
29.         UserForm1.Show
    
30.     End If
    
31. End Sub

複製代碼

修改後

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim Rng As Range, I As Integer
   
3.   With Target
   
4.     '.Select   '多一次確認
   
5.     If .Column = 4 Or .Column = 12 Then
   
6.         If Cells(.Row, 4) <> "" And Cells(.Row, 12) <> "" Then
   
7.             For I = 1 To Cells(Rows.Count, .Column).End(xlUp).Row
   
8.                 If Cells(I, 4) = Cells(.Row, 4) And Cells(I, 12) = Cells(.Row, 12) And I <> .Row Then
   
9.                     If Rng Is Nothing Then
   
10.                         Set Rng = Union(Cells(I, 4), Cells(I, 12))
    
11.                     Else
    
12.                         Set Rng = Union(Rng, Cells(I, 4), Cells(I, 12))
    
13.                     End If
    
14.                 End If
    
15.             Next
    
16.             If Not Rng Is Nothing Then
    
17.                 Set Rng = Union(Rng, Cells(.Row, 4), Cells(.Row, 12))
    
18.                 Rng.Select
    
19.                 'MsgBox Cells(.Row, 4) & vbNewLine & Cells(.Row, 12) & vbNewLine & "出現重複 "
    
20.                 UserForm2.Show
    
21.             End If
    
22.         End If
    
23.     End If
    
24.   End With
    
25.   
    
26.     If Target.Cells.Count > 1 Then Exit Sub
    
27.         If Union(Target, [K:K]).Address <> [K:K].Address Then Exit Sub
    
28.         If Target = "紅色" Then
    
29.         UserForm1.Show
    
30.     End If
    
31.    
    
32.     If Target.Cells.Count > 1 Then Exit Sub
    
33.         If Union(Target, [K:K]).Address <> [K:K].Address Then Exit Sub
    
34.         If Target = "藍色" Then
    
35.         UserForm3.Show
    
36.     End If
    
37. End Sub

複製代碼

測試結果：UserForm1和UserForm2有出來，新增的UserForm3沒出來。

GBKEE

回復 1# av8d

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.   Dim Rng As Range, I As Integer
   
4.   With Target
   
5.     '.Select   '多一次確認
   
6.     If .Column = 4 Or .Column = 12 Then
   
7.         If Cells(.Row, 4) <> "" And Cells(.Row, 12) <> "" Then
   
8.             For I = 1 To Cells(Rows.Count, .Column).End(xlUp).Row
   
9.                 If Cells(I, 4) = Cells(.Row, 4) And Cells(I, 12) = Cells(.Row, 12) And I <> .Row Then
   
10.                     If Rng Is Nothing Then
    
11.                         Set Rng = Union(Cells(I, 4), Cells(I, 12))
    
12.                     Else
    
13.                         Set Rng = Union(Rng, Cells(I, 4), Cells(I, 12))
    
14.                     End If
    
15.                 End If
    
16.             Next
    
17.             If Not Rng Is Nothing Then
    
18.                 Set Rng = Union(Rng, Cells(.Row, 4), Cells(.Row, 12))
    
19.                 Rng.Select
    
20.                 'MsgBox Cells(.Row, 4) & vbNewLine & Cells(.Row, 12) & vbNewLine & "出現重複 "
    
21.                ' UserForm2.Show
    
22.             End If
    
23.         End If
    
24.     End If
    
25.     If .Cells.Count > 1 Then Exit Sub
    
26.     If Union(.Cells, [K:K]).Address <> [K:K].Address Then Exit Sub
    
27.     If .Cells = "紅色" Then
    
28.         UserForm1.Show
    
29.     ElseIf .Cells = "藍色" Then
    
30.         UserForm3.Show
    
31.     End If
    
32.   End With   
    
33. End Sub

複製代碼