'セル範囲もZ軌道
Function aa(r As Range)
Dim x As Range
For Each x In r
Debug.Print x.Address(0, 0)
Next
End Function
'aa excel.application.InputBox(prompt:="セル指定",type:=8) 'Type:=8は名前付き引数を使っている
'ユニーク、一意のデータを１列目、出現回数を２列名に出力
Function myUniqe2(r As Range)
Dim col As New Collection 'コレクションオブジェクト
Dim colAll As New Collection
Dim x
For Each x In r '引数のRangeオブジェクトを個々にxに入れる
colAll.Add VBA.CStr(x)
On Error GoTo myErr 'エラーの罠
col.Add VBA.CStr(x), VBA.CStr(x)
On Error GoTo 0 'エラートラップのリセット
Next
ReDim ar(10000, 1) 'NA大作のため大きめの配列にした。１は0と１で2列
Dim i As Integer, cnt As Integer
Dim xx
For Each x In col '一意なコレクション
cnt = 0 '個数の初期化
For Each xx In colAll '全データ
If xx = x Then cnt = cnt + 1 '全データを順番にxxに入れてｘと比較
Next
ar(i, 0) = x '値
ar(i, 1) = cnt '個数
i = i + 1
Next
myUniqe2 = ar
Exit Function
myErr: 'ラベル：を付ける
Resume Next
End Function
'ユニーク、一意のデータを１列に出力
Function myUniqe(r As Range)
Dim col As New Collection
Dim x
For Each x In r
On Error GoTo myErr
col.Add x, VBA.CStr(x)
On Error GoTo 0
Next
ReDim ar(1000, 0) 'NA大作のため大きめの配列にした
Dim i As Integer
For Each x In col
ar(i, 0) = x
i = i + 1
Next
myUniqe = ar
Exit Function
myErr:
Resume Next
End Function
'for each x in myUniqe(range("b4:b14")):?x:next 'イミディエイト実行用
'自作VLOOKUP関数。完全一致専用
Function myLookUp(検索値これは検索範囲の一番左列, 検索範囲 As Range, 列番号 As Long)
Dim ar()
ar = 検索範囲
Dim i As Integer '行だけ
For i = 1 To UBound(ar, 1) '行の処理
If 検索値これは検索範囲の一番左列 = ar(i, 1) Then
myLookUp = ar(i, 列番号)
Exit Function
End If
Next
End Function
'?myLookUp("ken", Range("e4:h12"), 2)
ややこしい関数も自作でいこう！。これは自作でないとできない。それにとっても自由。
'自作VLOOKUP関数
Function myLookUp2(検索値, 検索列番号, 全範囲 As Range)
Dim ar()
ar = 全範囲
Dim i As Integer, j As Integer
ReDim arr(1 To 100, 1 To 100)'10000とかすると飛びます
Dim ii As Integer 'arrの行番号用、列はjを使う
For i = 1 To UBound(ar, 1)
j = 1
If VBA.CStr(ar(i, 検索列番号)) Like 検索値 Then
ii = ii + 1
For j = 1 To UBound(ar, 2)
arr(ii, j) = ar(i, j)
Next
End If
Next
myLookUp2 = arr
End Function
'?myLookUp2("*k*", 3,Range("e4:h12"))(0,0)
