根据A列关键字母在B列输出响应的文字

陈正

各位大大好，如附图所示

有一个数组，是有一些字母组成的，其中每个字母表示不同的含义，
譬如说P 表示压力，F表示流量，I表示指示，C表示控制，A表示报警，T表示温度，L表示液位。
我在A列中罗列了几种组合，我希望能在B列按照例子所示，读取出A列每行表示的文字内容。
一般来说，A列第一个字母只会是L,P,T,F这四个之一，后边字母是I,C,A之类的各种组合。
想法是把A列每个字母进行循环后与数组里每个元素进行比较，但这样感觉略繁琐，也没写出来，想问下想实现这个功能程序该怎么写？
谢谢。

shiruiqiang

按图创建字典，每个单元格遍历一下

cxy0725

Sub 解析文字内容()
    ' 定义字母含义的映射数组
    Dim letterMap As Variant
    letterMap = Array("P-压力", "F-流量", "I-指示", "C-控制", "A-报警", "T-温度", "L-液位")
   
    ' 获取A列的数据范围
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   
    ' 遍历A列中的每一行，解析文字内容并写入B列
    Dim i As Long
    For i = 1 To lastRow
        Dim content As String
        content = Cells(i, "A").Value
        
        ' 解析第一个字母
        Dim firstLetter As String
        firstLetter = Left(content, 1)
        Dim meaning As String
        meaning = ""
        Dim j As Long
        For j = LBound(letterMap) To UBound(letterMap)
            If Left(letterMap(j), 1) = firstLetter Then
                meaning = Mid(letterMap(j), 3)
                Exit For
            End If
        Next j
        
        ' 解析后续字母
        Dim restLetters As String
        restLetters = Mid(content, 2)
        Dim parts As Variant
        parts = Split(restLetters, "-")
        Dim k As Long
        For k = LBound(parts) To UBound(parts)
            For j = LBound(letterMap) To UBound(letterMap)
                If Left(letterMap(j), 1) = parts(k) Then
                    meaning = meaning & "-" & Mid(letterMap(j), 3)
                    Exit For
                End If
            Next j
        Next k
        
        ' 将解析结果写入B列
        Cells(i, "B").Value = meaning
    Next i
End Sub

cxy0725

Sub 解析文字内容()
    ' 定义字母含义的映射数组
    Dim letterMap As Variant
    letterMap = Array("P-压力", "F-流量", "I-指示", "C-控制", "A-报警", "T-温度", "L-液位")
   
    ' 获取A列的数据范围
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   
    ' 遍历A列中的每一行，解析文字内容并写入B列
    Dim i As Long
    For i = 1 To lastRow
        Dim content As String
        content = Cells(i, "A").Value
        
        ' 解析第一个字母
        Dim firstLetter As String
        firstLetter = Left(content, 1)
        Dim meaning As String
        meaning = ""
        Dim j As Long
        For j = LBound(letterMap) To UBound(letterMap)
            If Left(letterMap(j), 1) = firstLetter Then
                meaning = Mid(letterMap(j), 3)
                Exit For
            End If
        Next j
        
        ' 解析后续字母
        Dim restLetters As String
        restLetters = Mid(content, 2)
        Dim parts As Variant
        parts = Split(restLetters, "-")
        Dim k As Long
        For k = LBound(parts) To UBound(parts)
            For j = LBound(letterMap) To UBound(letterMap)
                If Left(letterMap(j), 1) = parts(k) Then
                    meaning = meaning & "-" & Mid(letterMap(j), 3)
                    Exit For
                End If
            Next j
        Next k
        
        ' 将解析结果写入B列
        Cells(i, "B").Value = meaning
    Next i
End Sub

mmwwdd