SafeValue.vba

Option Explicit

' セルに代入しても自動変換されないように値を加工する
' BUG: 日本語以外には対応していない
' BUG: サロゲートペアには対応してない
Function SafeValue(v As Variant) As Variant
    Dim c As String
    Dim narrowString As String
    c = Left(v, 1)
    narrowString = StrConv(c, vbNarrow)

    Select Case VarType(v)
    Case VbVarType.vbString:
        ' 先頭文字による以下の自動変換を避ける
        '  -: 数値と解釈しようとしてエラーになる
        '  0-9: 数値(文字列ではなく)になる。結果先頭の0がなくなる。全角数値は半角になる。
        '  =: 数式に変換する(結果エラーになる)
        '  $: 数値が続くと通貨になる
        '  %: 数値が続くと%表記になる
        '  +: 数値と解釈しようとしてエラーになる
        '  ': 後に続く文字列を文字列と解釈するために、' がなくなる
        '  .: 後に数値が続くと小数点と解釈する
        '  空白: 後に数値が続くと空白がなくなる
        If narrowString = "-" Or narrowString Like "[0-9=$%+'. ]" Then
            SafeValue = "'" & v
            Exit Function
        End If
    End Select
    SafeValue = v
End Function

Function AssertValue(code As Long, expect As String, actual As String) As Boolean
    If expect = actual Then
        ' Debug.Print "ok: " & actual
        AssertValue = True
    Else
        Debug.Print "bad: code: [&H" & Hex(code) & "] expect: [" & expect & "], actual: [" & actual & "]"
        AssertValue = False
    End If
End Function

Function test(i As Long, r As Range, c As String) As Boolean
    r.Value = SafeValue(c)

    test = AssertValue(i, c, r.Value)
End Function

Sub test_SafeValue()
    Dim i As Long

    Range("A:E").Delete Shift:=xlShiftToLeft

    For i = 0 To 65535
        Cells(i + 1, "A").Value = "&H" & Hex(i)
        
        Dim t1 As Boolean, t2 As Boolean, t3 As Boolean

        t1 = test(i, Cells(i + 1, "C"), ChrW(i))
        t2 = test(i, Cells(i + 1, "D"), ChrW(i) & "a")
        t3 = test(i, Cells(i + 1, "E"), ChrW(i) & "0")
        If t1 And t2 And t3 Then
        Else
            Cells(i + 1, "B").Value = "×"
        End If
    Next
End Sub