简缩码转全码，复杂的字符串整合方式

楼主 kevinchengcw	如何将缩写后的代码展开成全部的编码，本例为您提供一个示范，代码讲解如下： Sub test() Dim Arr1, Arr2, Arr3, Arr4, ArrT Dim M, N, I, T, A, B, C As Integer Dim Str, Result As String For M = 2 To [c65536].End(3).Row '取得数据循环行号范围 Result = "" '初始化并清空结果字符串 If InStr(Cells(M, 3).Value, "),") > 0 Then '判断是否有多段文字的特征存在 Str = Replace(Cells(M, 3).Value, "),", ")" & vbTab) '在多段特征文字的，号替换成Tab字符便于拆分 Arr1 = Split(Str, vbTab) '将拆分放入数组Arr1里 Else ReDim Arr1(0 To 0) '如果不存在多段则重定义数组Arr1为一个成员的数组，防止出错 Arr1(0) = Cells(M, 3).Value '赋值 End If For N = LBound(Arr1) To UBound(Arr1) '循环处理数组Arr1里的数据 Str = Replace(Arr1(N), "(", vbTab) '利用左括号来拆分数据 Str = Replace(Str, ")", "") '清除右括号 Do While InStr(Str, vbTab & vbTab) > 0 '清除连续两个以上的tab字符，以防止拆分时出现空白字符成员 Str = Replace(Str, vbTab & vbTab, vbTab) Loop Arr2 = Split(Str, vbTab) '利用tab字符拆分字符串放到数组Arr2里 Str = "" If UBound(Arr2) >= 1 Then '如果数组Arr2里存在两个以上的成员，则 If InStr(Arr2(1), "-") > 0 And InStr(Arr2(1), ",") > 0 Then '判断是否存在即有个体又有区间序列存在的情况 ArrT = Split(Arr2(1), ",") '先以逗号处理个体，这样将出现个体与区间并存于数组ArrT里 If IsNumeric(Left(ArrT(0), 1)) Then '判断数组的第一个成员的第一个字符是否为数值 For I = LBound(ArrT) To UBound(ArrT) '循环处理数组ArrT里的各个成员 If InStr(ArrT(I), "-") > 0 Then '如果当前成员含有“-”字符，说明是区间序列，则 For T = Val(Split(ArrT(I), "-")(0)) To Val(Split(ArrT(I), "-")(1)) '因前面已判断为数字，则利用“-”拆分成起始及终止两个数值，并利用循环连接到字符串Str If Str = "" Then Str = T Else Str = Str & "," & T End If Next T Else '对不是区间序列的直接连接 If Str = "" Then Str = ArrT(I) Else Str = Str & "," & ArrT(I) End If End If Next I Arr3 = Split(Str, ",") '最后利用逗号分割字符串并放入数组Arr3 Else For I = LBound(ArrT) To UBound(ArrT) For T = Asc(UCase(ArrT(0))) To Asc(UCase(ArrT(1))) '对不是数值的成员，将其字符全部大写，然后取其字符值区间进行循环，并利用chr()函数转换成对应字符进行连接 If Str = "" Then Str = Chr(T) Else Str = Str & "," & Chr(T) End If Next T Next I Arr3 = Split(Str, ",") End If ElseIf InStr(Arr2(1), "-") > 0 Then '处理只有区间序列的情况 ArrT = Split(Arr2(1), ",") If IsNumeric(Left(Split(Arr2(1), "-")(0), 1)) Then For I = LBound(ArrT) To UBound(ArrT) For T = Val(Split(ArrT(I), "-")(0)) To Val(Split(ArrT(I), "-")(1)) If Str = "" Then Str = T Else Str = Str & "," & T End If Next T Next I Arr3 = Split(Str, ",") Else '其他情况的处理 For I = LBound(ArrT) To UBound(ArrT) If InStr(ArrT(I), "-") > 0 Then For T = Asc(UCase(Split(ArrT(I), "-")(0))) To Asc(UCase(Split(ArrT(I), "-")(1))) If Str = "" Then Str = Chr(T) Else Str = Str & "," & Chr(T) End If Next T Else If Str = "" Then Str = ArrT(I) Else Str = Str & "," & ArrT(I) End If End If Next I Arr3 = Split(Str, ",") End If Else Arr3 = Split(Arr2(1), ",") End If End If Select Case UBound(Arr2) '生成结果前判断数组的成员数 Case Is = 2 '有三个成员的，先处理第三个成员 If InStr(Arr2(2), "-") Then Str = "" For I = Asc(UCase(Split(Arr2(2), "-")(0))) To Asc(UCase(Split(Arr2(2), "-")(1))) If Str = "" Then Str = Chr(I) Else Str = Str & "," & Chr(I) End If Next I Arr4 = Split(Str, ",") Else Arr4 = Split(Arr2(2), ",") End If For B = LBound(Arr3) To UBound(Arr3) For C = LBound(Arr4) To UBound(Arr4) If Result = "" Then Result = Arr2(0) & Arr3(B) & Arr4(C) '对取得的结果循环连接得到结果字符串 Else Result = Result & "," & Arr2(0) & Arr3(B) & Arr4(C) End If Next C Next B Case Is = 1 '两个成员时因都已处理完成，直接连接 For B = LBound(Arr3) To UBound(Arr3) If Result = "" Then Result = Arr2(0) & Arr3(B) Else Result = Result & "," & Arr2(0) & Arr3(B) End If Next B Case Else Result = Arr1(0) '一个成员时直接等于原值 End Select Next N '循环到数组下一成员 Cells(M, 7) = Result '将结果写入单元格 Next M '处理下一单元格 End Sub 转换效果如下(红色为源码，绿色为扩展后的编码)： R(13,22,23,25,27,62),R(85,86,88)(A-C) R13,R22,R23,R25,R27,R62,R85A,R85B,R85C,R86A,R86B,R86C,R88A,R88B,R88C C(6-9,29,34,36,37,42),CX(2-5,10-13,18-20,1A-1F,Y2),CX22(A,C,E,G),CX25(A-L),C71(A-C),CX(8,27)(A,B),CX(28,29,30)(A-E),CX35(A-C) C6,C7,C8,C9,C29,C34,C36,C37,C42,CX2,CX3,CX4,CX5,CX10,CX11,CX12,CX13,CX18,CX19,CX20,CX1,CXY2,CX22A,CX22C,CX22E,CX22G,CX25A,CX25B,CX25C,CX25D,CX25E,CX25F,CX25G,CX25H,CX25I,CX25J,CX25K,CX25L,C71A,C71B,C71C,CX8A,CX8B,CX27A,CX27B,CX28A,CX28B,CX28C,CX28D,CX28E,CX29A,CX29B,CX29C,CX29D,CX29E,CX30A,CX30B,CX30C,CX30D,CX30E,CX35A,CX35B,CX35C 综上，所用方法类似于所写的VBA解释器中的断句方法，具体内容请参见附件整理BOM.rar
2楼 wnianzhong	学习了,谢谢!
3楼 wangqilong1980	无论如何也要顶一下喽，收了好好用。
4楼 lisan	字典要有很强的逻辑性。
5楼 wise	学习
6楼海洋之星	学习了,谢谢!