|
管理員
|
以本樓的問題，迪西加上說明描述後的程式
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
|