VB如何用百分号格式化字符(像%s %d的)

简单做了个格式化字符串解析，供参考

Private Sub Command1_Click()
    s = printf("%ttt\n%s\t\t%f %d\n", "aa", 3.1415926, 999)
    Debug.Print s
End Sub

Private Function printf(formatStr$, ParamArray Parameters() As Variant)
   
    Dim Count%, index%, vari%, slen%, s$
   
    index = InStr(formatStr, "%")
   
    If index = 0 Then
        printf = formatStr
        Exit Function
    End If
   
    printf = Mid(formatStr, 1, index - 1)
    slen = Len(formatStr)
   
    vari = 0
    For i = index To slen
        s = Mid(formatStr, i, 1)
        
        If s = "%" And i + 1 < slen Then
            i = i + 1
            s = Mid(formatStr, i, 1)
            Select Case s
            Case "%"
                s = "%"
            Case "s"
                s = Parameters(vari)
                vari = vari + 1
            Case "f"
                s = Format(Parameters(vari))
                vari = vari + 1
            Case "d"
                s = Format(Parameters(vari))
                vari = vari + 1
            Case Else   '%后面的不识别则直接输出
                s = "%" & s
            End Select
            
        End If
        printf = printf & s
    Next
   
    printf = Replace(printf, "\n", vbCrLf)
    printf = Replace(printf, "\t", vbTab)
   
   
End Function

Option Explicit

#Const 斜杠N转意回车换行号 = True

Public Function FormatF(Ss As String, ParamArray F() As Variant) As String
Dim str1 As String              '中间数据的最终结果
Dim i As Long, s As String      'i 循环变量，s 中间判断字符
Dim FL As Long, FU As Long      '可变参数的下标最小值，最大值
Dim FJ As Long                  '可变参数使用的下标
Dim SFU As Long                 '处理%的最大下标
Dim SF() As String              '处理%的分解后的数据

FL = LBound(F)
FU = UBound(F)
If FU < FL Then         '如果除格式字符串外未提供数据
    FormatF = Ss        '原样返回
    Exit Function       '结束函数
End If
FJ = FL

'先处理\
'不能使用替换处理原因：如 \\n 替换会转意错误，不管先替换哪个
'先处理\，可以避免处理参数里后多出 \ 来导致转意错误
    i = 0           '起始搜索位置为1
    str1 = Ss       '原字符不破坏
Do
    i = InStr(i + 1, str1, "\")       '查找
    If i > 0 Then                   '找到，则转意并拼接
        str1 = Left(str1, i - 1) & fxz(Mid(str1, i + 1, 1)) & Mid(str1, i + 2)
    Else
        Exit Do
    End If
Loop

'处理%
'为什么样分割字符串
'如转入参数 "%s","a%d"  ，使用查找法，会导致%s 扩展成 a%d ，然后从下一位开始，导致查找到%d

SF = Split(str1, "%")    '直接按%分割字符串
SFU = UBound(SF)
FJ = FL                  '第一个参数

'注，所有的处理，这里都没对参数是否符合要求进行判断。必须判断。
For i = FL + 1 To SFU    '每一段,第一段为第一个%前的内容，不需要分析
    s = Left(SF(i), 1)   '第一个字符
                         '这里决定不支持修饰，[flags][width][.precision][length]
                         '如果需要支持，则需要从第一个字符查找指定的字符，找到后再分解处理
    '已支持 s d f x X e E c
    Select Case s
        Case "s"            '字符串输出
            If FJ <= FU Then
                SF(i) = F(FJ) & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case "d"            '整数输出,加INT函数，小数只输出整数部分
            If FJ <= FU Then
                SF(i) = str(Int(F(FJ))) & Mid(SF(i), 2)  'str，正数保留前导空格
            End If
            FJ = FJ + 1
        Case "f"             '浮点输出
            If FJ <= FU Then
                SF(i) = Format(F(FJ), "0.##################") & Mid(SF(i), 2)   '小数点后最多18位数
                'SF(i) = Format(F(FJ), "0.000000") & Mid(SF(i), 2)   '小数点后6位数，不足补零，此行未测试
            End If
            FJ = FJ + 1
        Case "x"            '整数按十六进制输出，不会前面补零,字母按小写
            If FJ <= FU Then
                SF(i) = LCase(Hex(F(FJ))) & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case "X"           '整数按十六进制输出，不会前面补零,字母按大写
            If FJ <= FU Then
                SF(i) = Hex(F(FJ)) & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case "e"
            If FJ <= FU Then    '科学计数，保留6位小数，2位指数,未完全测试
                SF(i) = Format(F(FJ), "0.######e-##") & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case "E"
            If FJ <= FU Then    '科学计数，保留6位小数，2位指数,未完全测试
                SF(i) = Format(F(FJ), "0.######E-##") & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case "c"
            If FJ <= FU Then    '调用chr函数后输出,这里超范围也许会导致错误，
                SF(i) = Chr(val(F(FJ))) & Mid(SF(i), 2)
            End If
            FJ = FJ + 1
        Case Else       '不属于以上情况，补上被吃的%
            SF(i) = "%" & SF(i)
            
    End Select
Next i
    str1 = Join(SF, "")
    If FJ > FU + 1 Then     '参数不足
        Err.Raise 450       '创建错误，该错误能被错误处理语句捕捉到，错误的参数个数。DEBUG好用。
    End If

FormatF = str1
End Function


Private Function fxz(ss As String) As String
    Select Case ss       '转意，直接照C抄的

    Case "'", """", "?", "\"        '这四个是原意输出
        fxz = ss
    Case "a"
        fxz = Chr(7)
    Case "b"
        fxz = Chr(8)
    Case "f"
        fxz = Chr(12)
    Case "n"
        #If 斜杠N转意回车换行号 Then    '根据编译选项选择
            fxz = vbCrLf        'windows平台需要2个字符来换行，所以默认用这个
        #Else
            fxz = Chr(10)
        #End If
    Case "r"
        fxz = Chr(13)
    Case "t"
        fxz = Chr(9)
    Case "v"
        fxz = Chr(11)
    Case Else    '非转意(吃掉斜杠)和转成本身字符的
        fxz = ss
        'fxz = "\" & ss        '这种不吃掉斜杠
    End Select
End Function