返回列表 上一主題 發帖

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

av8d

帖子
703 
主題
276 
精華
0 
積分
1005 
點名
1  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2024-5-29 
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沒出來。
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題