查看單個文章
舊 2015-06-17, 12:55 PM   #11 (permalink)
getter
管理員
 
getter 的頭像
榮譽勳章
UID - 6433
在線等級: 級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時級別:94 | 在線時長:9281小時 | 升級還需:124小時
註冊日期: 2002-12-08
住址: 天線星球
文章: 7951
精華: 0
現金: 19483 金幣
資產: 764769 金幣
預設

以本樓的問題,迪西加上說明描述後的程式

Excel 2003:

COUNT_NR2:數值和字串
語法:
Sub Auto_Open()
  ' COUNT_NR2 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NR2", _
  Description:="以數值和字串為條件,計算不包含重複資料出現的次數。參考 COUNT、COUNTA。" & Chr(13) & Chr(10) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"
End Sub


Function COUNT_NR2(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NR2 ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以數值和字串為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNT、COUNTA 內建函數。
  '
  ' Value, …:可以是 (數值) 或 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear
  
  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsLogical(Value_new(i)) Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i
  
  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NR2 = Count
End Function

COUNT_NRA:字串
語法:
Sub Auto_Open()
  ' COUNT_NRA 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRA", _
  Description:="以字串為條件,計算不包含重複資料出現的次數。參考 COUNTA。" & Chr(13) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"
End Sub


Function COUNT_NRA(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRA ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以字串為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNTA 內建函數。
  '
  ' Value, …:可以是 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear
  
  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsNonText(Value_new(i)) Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i

  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRA = Count
End Function

COUNT_NRN:數值
語法:
Sub Auto_Open()
  ' COUNT_NRN 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRN", _
  Description:="以數值為條件,計算不包含重複資料出現的次數。參考 COUNT。" & Chr(13) & Chr(10) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"
End Sub


Function COUNT_NRN(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRN ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以數值為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNT 內建函數。
  '
  ' Value, …:可以是 (數值)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear

  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsNumber(Value_new(i)) = False Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i

  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRN = Count
End Function

COUNT_NRS:模式選擇
語法:
Sub Auto_Open()
  ' COUNT_NRS 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRS", _
  Description:="以模式選擇過濾條件,計算不包含重複資料出現的次數。" & Chr(13) & Chr(10)) & _
               "  Mode:0 表示以數值計算。 1 表示以字串計算。 2 表示以數值和字串計算。" & Chr(13) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"
End Sub


Function COUNT_NRS(ByVal Mode As Byte, ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRS ver. 1b
  '     動作1:資料選擇範圍
  '
  ' 以模式選擇過濾條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNTIF 內建函數。
  ' 引數的使用方式 類似於 函數(模式,值,值,…)
  ' Mode:0 表示以(數值)計算。COUNT_NRS(0,A1:B8,111,566)
  '       1 表示以(字串)計算。COUNT_NRS(1,A1:B8,C1,D5,"ABC","AAV")
  '       2 表示以(數值和字串)計算。COUNT_NRS(2,A1:B8,C1,D5,111,"AAV")
  ' Value, …:可以是 (數值) 或 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
 Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear

  For i = LBound(Value_new) To UBound(Value_new)
    Select Case Mode
      Case 0
        GoTo term_1
      Case 1
        GoTo term_2
      Case 2
        GoTo term_3
      Case Else
        GoTo term_3
    End Select
term_1:
    If WorksheetFunction.IsNumber(Value_new(i)) = False Then Value_new(i) = ""
    GoTo term_Next
term_2:
    If WorksheetFunction.IsNonText(Value_new(i)) Then Value_new(i) = ""
    GoTo term_Next
term_3:
    If WorksheetFunction.IsLogical(Value_new(i)) Then Value_new(i) = ""
    GoTo term_Next
term_Next:
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i
  
  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRS = Count
End Function

4 個函數一起
語法:
Sub Auto_Open()
  ' COUNT_NR2 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NR2", _
  Description:="以數值和字串為條件,計算不包含重複資料出現的次數。參考 COUNT、COUNTA。" & Chr(13) & Chr(10) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"

  ' COUNT_NRN 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRN", _
  Description:="以數值為條件,計算不包含重複資料出現的次數。參考 COUNT。" & Chr(13) & Chr(10) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"

  ' COUNT_NRA 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRA", _
  Description:="以字串為條件,計算不包含重複資料出現的次數。參考 COUNTA。" & Chr(13) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"

  
  ' COUNT_NRS 自動載入 [描述] 說明
  Application.MacroOptions Macro:="COUNT_NRS", _
  Description:="以模式選擇過濾條件,計算不包含重複資料出現的次數。" & Chr(13) & Chr(10)) & _
               "  Mode:0 表示以數值計算。 1 表示以字串計算。 2 表示以數值和字串計算。" & Chr(13) & Chr(10) & _
               "  Value, …:可以是數值、字串、單一參照值、連續參照值。"
End Sub


Function COUNT_NR2(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NR2 ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以數值和字串為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNT、COUNTA 內建函數。
  '
  ' Value, …:可以是 (數值) 或 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear
  
  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsLogical(Value_new(i)) Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i
  
  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NR2 = Count
End Function


Function COUNT_NRN(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRN ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以數值為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNT 內建函數。
  '
  ' Value, …:可以是 (數值)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear

  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsNumber(Value_new(i)) = False Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i

  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRN = Count
End Function


Function COUNT_NRA(ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRA ver. 1a
  '     動作1:資料選擇範圍
  '
  ' 以字串為條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNTA 內建函數。
  '
  ' Value, …:可以是 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
  Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear
  
  For i = LBound(Value_new) To UBound(Value_new)
    If WorksheetFunction.IsNonText(Value_new(i)) Then Value_new(i) = ""
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i

  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRA = Count
End Function


Function COUNT_NRS(ByVal Mode As Byte, ParamArray Value() As Variant)
  '═════════════════════════
  '     COUNT_NRS ver. 1b
  '     動作1:資料選擇範圍
  '
  ' 以模式選擇過濾條件的計算資料出現的次數,
  ' 當有重複的 (值) 時後,該值只計算一次。
  ' 參考 COUNTIF 內建函數。
  ' 引數的使用方式 類似於 函數(模式,值,值,…)
  ' Mode:0 表示以(數值)計算。COUNT_NRS(0,A1:B8,111,566)
  '       1 表示以(字串)計算。COUNT_NRS(1,A1:B8,C1,D5,"ABC","AAV")
  '       2 表示以(數值和字串)計算。COUNT_NRS(2,A1:B8,C1,D5,111,"AAV")
  ' Value, …:可以是 (數值) 或 (字串)、單一參照值、連續參照值,
  ' 數量尚最少 1 個,多個資料時,以 "," 區分。
  '═════════════════════════
 Dim i, j, Count, arg, Value_new() As Variant
  On Error Resume Next
  
  Count = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Count = Count + 1
    Next arg
  Next i
  Err.Clear
  
  ReDim Value_new(Count - 1)
  
  j = 0
  For i = LBound(Value) To UBound(Value)
    Err.Clear
    For Each arg In Value(i)
      Value_new(j) = arg
      j = j + 1
    Next arg
    If Err.Number = 92 Then Value_new(j - 1) = Value(i)
  Next i
  Err.Clear

  For i = LBound(Value_new) To UBound(Value_new)
    Select Case Mode
      Case 0
        GoTo term_1
      Case 1
        GoTo term_2
      Case 2
        GoTo term_3
      Case Else
        GoTo term_3
    End Select
term_1:
    If WorksheetFunction.IsNumber(Value_new(i)) = False Then Value_new(i) = ""
    GoTo term_Next
term_2:
    If WorksheetFunction.IsNonText(Value_new(i)) Then Value_new(i) = ""
    GoTo term_Next
term_3:
    If WorksheetFunction.IsLogical(Value_new(i)) Then Value_new(i) = ""
    GoTo term_Next
term_Next:
    If i = UBound(Value_new) Then Exit For
    For j = i + 1 To UBound(Value_new)
      If Value_new(i) = "" Then Exit For
      If Value_new(i) = Value_new(j) Then Value_new(j) = ""
    Next j
  Next i
  
  Count = 0
  For Each arg In Value_new
    If arg <> "" Then Count = Count + 1
  Next arg
  COUNT_NRS = Count
End Function
__________________
在「專業主討論區」中的問題解決後,要記得按一下 http://forum.slime.com.tw/images/stamps/is_solved.gif 按鈕喔,
這是一種禮貌動作。

一樣是在「專業主討論區」中發問,不管問題解決與否,都要回應別人的回答文喔。
不然搞 [斷頭文],只看不回應,下次被別人列入黑名單就不要怪人喔。

天線寶寶說再見啦~ ... 天線寶寶說再見啦~

迪西:「再見~ 再見~」

Otaku Culture Party 關心您 ...
getter 目前離線  
送花文章: 37553, 收花文章: 6254 篇, 收花: 25600 次
回覆時引用此帖
向 getter 送花的會員:
a471 (2015-06-17)
感謝您發表一篇好文章