如何用VBA实现ASCII艺术字拼接？代码遇动态数组调用难题

核心问题解决思路 #

针对你遇到的两个问题，我们可以通过字典存储字母结构和逐行拼接字符串来解决：

1. 动态获取对应字母的ASCII数组：用字典统一管理 #

单独定义LtH、LtI这类数组无法动态关联字母，改用Dictionary存储，以字母为键，对应的7行结构数组为值，就能通过字母直接取出对应的ASCII结构。

2. ASCII字符串拼接：按行逐段组合 #

每个字母是7行的多行结构，不能直接按字母顺序拼接，需要逐行处理：遍历每行（共7行），把目标单词中每个字母的当前行内容拼接在一起，每行结束添加换行符，最后组合成完整的艺术字。

完整修正代码 #

Option Explicit

Sub BuildAsciiWrite(strTxt As String)
    Dim letterDict As Object
    Set letterDict = CreateObject("Scripting.Dictionary")
    
    ' 定义H的ASCII结构数组并存入字典
    Dim LtH(1 To 7) As String
    LtH(1) = "HHH    HHH"
    LtH(2) = "HHH    HHH"
    LtH(3) = "HHH    HHH"
    LtH(4) = "HHHHHHHHHH"
    LtH(5) = "HHH    HHH"
    LtH(6) = "HHH    HHH"
    LtH(7) = "HHH    HHH"
    letterDict.Add "H", LtH
    
    ' 定义I的ASCII结构数组并存入字典
    Dim LtI(1 To 7) As String
    LtI(1) = "IIIIIIIIIII"
    LtI(2) = "    III    "
    LtI(3) = "    III    "
    LtI(4) = "    III    "
    LtI(5) = "    III    "
    LtI(6) = "    III    "
    LtI(7) = "IIIIIIIIIII"
    letterDict.Add "I", LtI
    
    ' 转换为大写并拆分单词为单个字母
    strTxt = UCase(strTxt)
    Dim strArrayTxt() As String
    ReDim strArrayTxt(1 To Len(strTxt))
    Dim intLoop As Integer
    For intLoop = 1 To Len(strTxt)
        strArrayTxt(intLoop) = Mid$(strTxt, intLoop, 1)
    Next intLoop
    
    ' 拼接ASCII艺术字
    Dim strWrite As String
    Dim rowNum As Integer
    ' 遍历每一行（共7行）
    For rowNum = 1 To 7
        Dim letter As String
        ' 遍历目标单词的每个字母
        For Each letter In strArrayTxt
            ' 取出当前字母对应行的内容，拼接到当前行
            strWrite = strWrite & letterDict(letter)(rowNum) & "  " ' 加空格分隔字母
        Next letter
        ' 每行结束添加换行符
        strWrite = strWrite & vbCrLf
    Next rowNum
    
    ' 输出结果（可以在立即窗口查看，或者写入单元格/文件）
    Debug.Print strWrite
End Sub

' 测试子程序
Sub Test_BuildAsciiWrite()
    BuildAsciiWrite "Hi"
End Sub

代码关键说明 #

• 字典的使用：letterDict存储所有字母的ASCII结构，通过letterDict(字母)就能直接获取对应的数组，解决动态获取问题。
• 逐行拼接：外层循环控制行数，内层循环拼接每个字母的当前行内容，确保艺术字的每行结构正确。
• 分隔空格：拼接时添加" "是为了让字母之间有间隔，避免挤在一起，可根据需要调整。

内容的提问来源于stack exchange，提问作者Emanuele Tinari