返回列表 上一主題 發帖

符合兩筆資料自行顯示地區

本帖最後由 GBKEE 於 2014-12-10 07:14 編輯

Function(自訂函數)
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     With Target
  4.         If (.Column = 3 Or .Column = 10) And .Row >= 4 Then
  5.             Cells(.Row, "q") = EX_地區(Cells(.Row, "C") & "," & Cells(.Row, "J")& ",")
  6.          End If
  7.     End With
  8. End Sub
  9. Private Function EX_地區(Msg As String) As String
  10.     Dim AR, A, i
  11.     EX_地區 = ""
  12.     AR = Sheets("工作表2").Range("A1").CurrentRegion
  13.     AR = Application.Transpose(Application.Transpose(AR))
  14.     For i = 1 To UBound(AR)
  15.         A = Application.WorksheetFunction.Index(AR, i)
  16.         If InStr(UCase(Join(A, ",")), UCase(Msg)) = 1 Then
  17.             EX_地區 = A(3)
  18.             Exit For
  19.         End If
  20.     Next
  21. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# 周大偉
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     '其他程式碼
  4.     '其他程式碼
  5.     Ex Target
  6.     '其他程式碼
  7.     '其他程式碼
  8. End Sub
  9. Private Sub Ex(T As Range)
  10.     Application.EnableEvents = False
  11.     With T
  12.         If (.Column = 3 Or .Column = 10) And .Row >= 4 Then
  13.             Cells(.Row, "q") = EX_地區(Cells(.Row, "C") & "," & Cells(.Row, "J") & ",")
  14.         End If
  15.     End With
  16.     Application.EnableEvents = True
  17. End Sub
  18. Private Function EX_地區(Msg As String) As String
  19.     Dim AR, A, i
  20.     EX_地區 = ""
  21.     AR = Sheets("工作表2").Range("A1").CurrentRegion
  22.     AR = Application.Transpose(Application.Transpose(AR))
  23.     For i = 1 To UBound(AR)
  24.         A = Application.WorksheetFunction.Index(AR, i)
  25.         If InStr(UCase(Join(A, ",")), UCase(Msg)) = 1 Then
  26.             EX_地區 = A(3)
  27.             Exit For
  28.         End If
  29.     Next
  30. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# 周大偉
請將你原本的 Private Sub Worksheet_Change(ByVal T As Range)
複製在工作表的模組上,修改程序名稱為
例 Private Sub Ex_Sub1(ByVal T As Range)

原本的 Private Sub Worksheet_Change(ByVal T As Range)事件
修改內容如下
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Ex Target        'Target: 要傳遞給這副程式的變數
  4.    Ex_Sub1 Target
  5.     '其他程式碼
  6.    '其他程式碼
  7. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題