返回列表 上一主題 發帖

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

av8d

帖子
710 
主題
280 
精華
0 
積分
1016 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2025-1-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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沒出來。
收藏 分享

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
返回列表 上一主題