myLookup関数

mySUM関数に続いて第二弾。数式バーにカッコがいっぱい書いてませんか。プログラムだと限界はありませんし、スキルアップになります。

ワークシート関数を数式バーに３つ以上書く力をプログラム開発に向けましょう。プログラムのスキルアップの方が効率的です。

'自作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)

以下は、データ作成用。

Sub 表作成()
'
' Macro1 Macro
'
    If VBA.MsgBox("選択しているワークシートが無くなります！！！", vbOKCancel) = VBA.vbCancel Then Exit Sub
    
    Columns("A:h").Delete Shift:=xlToLeft
    
      Range("H3").Select
    ActiveCell.FormulaR1C1 = "phone"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "'0311111"
    Range("H5").Select
    ActiveCell.FormulaR1C1 = "'0751111"
    Range("H6").Select
    ActiveCell.FormulaR1C1 = "'061123"
    Range("H7").Select
    ActiveCell.FormulaR1C1 = "'075222"
    Range("H8").Select
    ActiveCell.FormulaR1C1 = "'0322222"
    Range("H9").Select
    ActiveCell.FormulaR1C1 = "'0521111"
    Range("H10").Select
    ActiveCell.FormulaR1C1 = "'0622222"
    Range("H11").Select
    ActiveCell.FormulaR1C1 = "'0753333"
    Range("H12").Select
    ActiveCell.FormulaR1C1 = "'063333"
    Range("H13").Select


    Range("E3").Select
    ActiveCell.FormulaR1C1 = "no"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "name"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "address"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("E4:E10").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("E4").Select
    Selection.AutoFill Destination:=Range("E4:E12"), Type:=xlFillSeries
    Range("E4:E10").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "tom"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "ken"
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "emi"
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "bob"
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "bill"
    Range("F9").Select
    ActiveCell.FormulaR1C1 = "ben"
    Range("F10").Select
    ActiveCell.FormulaR1C1 = "sam"
    Range("F11").Select
    ActiveCell.FormulaR1C1 = "may"
    Range("f12").Select
    ActiveCell.FormulaR1C1 = "ron"


    Range("G4").Select
    ActiveCell.FormulaR1C1 = "tokyo"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "kyoto"
    Range("G6").Select
    ActiveCell.FormulaR1C1 = "osaka"
    Range("G7").Select
    ActiveCell.FormulaR1C1 = "kyoto"
    Range("G8").Select
    ActiveCell.FormulaR1C1 = "tokyo"
    Range("G9").Select
    ActiveCell.FormulaR1C1 = "nagoya"
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "osaka"
    Range("G11").Select
    ActiveCell.FormulaR1C1 = "osaka"
    Range("G12").Select
    ActiveCell.FormulaR1C1 = "kyoto"
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A1").Select
    Selection.AutoFill Destination:=Range("A1:F1"), Type:=xlFillSeries
    Range("A1:F1").Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A12"), Type:=xlFillSeries
    Range("A4:A10").Select
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "tom"
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "ken"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "emi"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "bob"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "bill"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "ben"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "sam"
    Range("B11").Select
    ActiveCell.FormulaR1C1 = "may"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "ron"
    
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$E$3:$h$12"), , xlYes).Name = _
        "myTable"
End Sub