Board logo

標題: 新增一個相同的IF判別式，執行結果和修改前一樣？ [打印本頁]
作者: av8d    時間: 2013-6-17 11:00     標題: 新增一個相同的IF判別式，執行結果和修改前一樣？

本帖最後由 av8d 於 2013-6-17 11:01 編輯

修改前
  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    時間: 2013-6-19 14:16

回復 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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)