穴寸法テーブルを修正する

CATIA V5です。ちょっとこちらに挑戦しました。
Macro for editing tables. - DASSAULT: CATIA products - Eng-Tips
折角なので、あちらに投げるのは止めておきます。雰囲気的に・・・。

要はタップ穴を含めた穴寸法テーブルを作成した際に、タップ穴が
下穴径になるので、修正するのが手間なのでマクロで！って言うことと
理解しました。こんな感じですね。

ん～数値がちょっと違う。

座標寸法テーブルは頻繁に使うのですが、穴寸法テーブルは
あまり使ったことが無いです。
ひょっとしたら技術結果付きで穴寸法テーブルを作ったら直径が
タップ径になってくれるのでは！と期待しましたが、駄目なんですね。

厳しい現実です。世間の皆様はどうやっているのでしょうか？

'vba

Option Explicit

Private Const TARGET_KEY = "直径"

Sub CATMain()

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim view As DrawingView
    Set view = dDoc.sheets.ActiveSheet.views.Item(3)
    
    Dim table As DrawingTable
    Set table = view.Tables.Item(1)

    replaceme_diameter table, TARGET_KEY

    
End Sub


Private Sub replaceme_diameter( _
    ByVal table As DrawingTable, _
    ByVal key As String)

    Dim targetColumn As Long
    targetColumn = find_column_by_key( _
        table, _
        key, _
        1 _
    )
    If targetColumn < 0 Then
        MsgBox "[" & key & "]が見つかりませんでした"
        Exit Sub
    End If

    Dim msg As String
    msg = replaceme_cell( _
        table, _
        get_tap_dict(), _
        targetColumn _
    )

    MsgBox msg

End Sub


Private Function replaceme_cell( _
    ByVal table As DrawingTable, _
    ByVal dict As Object, _
    ByVal columnNumber As Long) _
    As String

    Dim msgCol As Collection
    Set msgCol = New Collection

    Dim cell As DrawingText
    Dim cellText As String
    Dim i As Long
    For i = 1 To table.NumberOfRows

        Set cell = table.GetCellObject(i, columnNumber)
        cellText = cell.text
        If Not dict.Exists(cellText) Then
            GoTo continue
        End If

        msgCol.Add i & "行目:" & cellText & "->" & dict.Item(cellText)

        cell.text = dict.Item(cellText)
        
continue:
    Next

    If msgCol.count < 1 Then
        msgCol.Add "変更したセルは有りませんでした"
    End If

    replaceme_cell = Join(col2ary(msgCol), vbCrLf)

End Function

Private Function col2ary( _
    ByVal col As Collection) _
    As Variant

    Dim ary() As Variant
    ReDim ary(col.count - 1)

    Dim i As Long
    For i = 1 To col.count
        ary(i - 1) = col.Item(i)
    Next
    
    col2ary = ary

End Function


Private Function get_tap_dict() _
    As Object

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    dict.Add "3.24", "M4"
    dict.Add "6.65", "M8"
    dict.Add "8.38", "M10"
    dict.Add "10.11", "M12"
    
    Set get_tap_dict = dict

End Function


Private Function find_column_by_key( _
    ByVal table As DrawingTable, _
    ByVal key As String, _
    ByVal rowNumber As Long) _
    As Long

    find_column_by_key = -1
    
    Dim i As Long
    For i = 1 To table.NumberOfColumns()
        If table.GetCellString(rowNumber, i) = key Then
            find_column_by_key = i
            Exit Function
        End If
    Next

End Function

面倒だったのでM4,M8,M10,M12しか調べませんでした。すいません。
テーブル作る際の小数点2桁以外だったらどうするのか？
径にφ付きだったらどうするのか？
とか考えませんでした。

φ付きでテーブル作れたような記憶なのですが、方法を忘れました・・・。