スピル時代のExcel VBA(3)

カルテ情報の検索参照関数

前回に定義した関数を使って、NC旋盤で製品を作成する時の、ツール情報を検索参照
する関数を定義します。
情報テーブル(KJ_)には、３桁のツール番号(TNO=01,31,02,～,08,38)毎に、ツールチップ番号(L)が
格納されています。ツールチップ番号(TNO)に、機械番号(K)を加算したのが、
機械ツールチップツールチップ番号(SNO)で４桁のキー(K + L)となっています。
工具テーブル(KZT_)と、工具データ(KDA_)は、機械ツールチップ番号(SNO)で検索可能であり、
最初にMATCHした行番号を各々、KZT列、KDA列に格納します。
その行番号を元に、工材名,N,LAST,分数のデータを引っ張ってきます。

Function L_KRT(J, Optional K = 2000, Optional S = "")
    Call START_MANUAL

    Const T = "T,TNO,KZT,工材名,KDA,N,LAST,分数"
    Const T__ = 1, TNO__ = 2, KZT__ = 3, 工材名__ = 4, KDA__ = 5, _
          N__ = 6, LAST__ = 7, 分数__ = 8

    S1 = RMT(Range("KJ_[[#Headers],[01]:[38]]"))
    S2 = RMT(Range("KJ_[[01]:[38]]"), J)

    S = L_PAIR(S1, S2, T)

    Call L_MI("KZT_[SNO]", S, KZT__, TNO__, K)
    Call L_MI("KDA_[SNO]", S, KDA__, TNO__, K)
    Call L_IFZS(S, TNO__)
    Call L_DI("KZT_[工材名]", S, 工材名__, KZT__)
    Call L_DI("KDA_[N]", S, N__, KDA__)
    Call L_DI("KDA_[LAST]", S, LAST__, KDA__)
    Call L_DI("KDA_[分数]", S, 分数__, KDA__)

    L_KRT = S

    Call START_AUTO
End Function

Sub L_MI(RN, S, J, P, Optional K = 0)
    Set R = Range(RN)
    For I = 1 To UBound(S, 1)
        L = S(I, P)
        If L > 0 Then S(I, J) = MI(R, K + L)
    Next I
    Set R = Nothing
End Sub

Sub L_IFZS(S, J)
    For I = 1 To UBound(S, 1)
        If S(I, J) = 0 Then S(I, J) = ""
    Next I
End Sub

Sub L_DI(RN, S, J, P)
    Set R = Range(RN)
    For I = 1 To UBound(S, 1)
        S(I, J) = DI(R, S(I, P))
    Next I
    Set R = Nothing
End Sub

作成した表はこのようになります。

(BC26) =L_KRT(15) ' 情報テーブルの１５行目のデータを抽出します。

列を並び替えて編集する関数

上の表は、KZT列,KDA列は不要です。加えて列の並びも変えることにします。

Function L_SELECT(R, T, Optional S = "")
    Call START_MANUAL

    R = R: TA = Split(T, ",")
    M = UBound(R, 1) - LBound(R, 1): N = UBound(TA) - LBound(TA) + 1
    S = L_INIT(M, T)

    For I = 0 To UBound(TA)
        For J = 1 To UBound(R, 2)
            If TA(I) = DI(R, 1, J) Then
                S(1, I + 1) = J
                Exit For
            End If
        Next J
    Next I
    For J = 1 To N
       L = Val(S(1, J))

       If 0 < L And L <= UBound(R, 2) Then
           For I = 1 To M
              S(I, J) = DI(R, I + 1, L)
           Next I
       End If
    Next J

    Call START_AUTO

    L_SELECT = S
End Function

(AV26) =L_SELECT(L_KRT(15),"T,工材名,TNO,N,LAST,分数")