VBA 拆分字符
A1原数据：
R(1,2,6,7,37,42,46,47,49,50,51-53),R80(A-H）
B1所要的效果：
R1,R2,R37,R42,R46,R47,R49,R50,R51,R52,R53,R6,R7,R80A,R80B,R80C,R80D,R80E,R80F,R80G,R80H
A2原数据：
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)
B2所要的效果：C29,C34,C36,C37,C42,C6,C7,C71A,C71B,C71C,C8,C9,CX10,CX11,CX12,CX13,CX18,CX19,CX1A,CX1B,CX1C,CX1D,CX1E,CX1F,CX2,CX20,CX22A,CX22C,CX22E,,CX22G,CX25A,CX25B,CX25C,CX25D,CX25E,CX25F,CX25G,CX25H,CX25I,CX25J,CX25K,CX25L,CX27A,CX27B,CX28A,CX28B,CX28C,CX28D,CX28E,CX29A,CX29B,CX29C,CX29D,CX29E,CX3,CX30A,CX30B,CX30C,CX30D,CX30E,CX35A,CX35B,CX35C,CX4,CX5,CX8A,CX8B,CXY2
怎样用VBA把原数据转换成所要的效果的数据？
[解决办法]
我是给你实现了，不过是比较直白的写法，没时间细想....
自己感觉写的难看，不过看你着急，我就献献丑，抛砖引玉吧：
Option Explicit'拆分连续字符Private Function GetSplitString(pStr As String) As String '从楼主提供的数据分析，有4种连续字符： '1.大于0的数字；2.单个字母；3.大于0的数字+单个字母；4.单个字母+大于0的的数字 Dim arr() As String Dim i As Long, j As Long Dim n As Long, m As Long Dim sTmp As String If InStr(pStr, "-") = 0 Then GetSplitString = pStr Exit Function End If arr = Split(pStr, "-") If IsNumeric(arr(0)) Then '数字 n = arr(0) m = arr(1) ReDim arr(n To m) For i = n To m arr(i) = i Next ElseIf Len(arr(0)) = 1 Then '单个字母 n = Asc(arr(0)) m = Asc(arr(1)) ReDim arr(n To m) For i = n To m arr(i) = Chr(i) Next ElseIf Val(arr(0)) > 0 Then '数字+单个字母 sTmp = Val(arr(0)) '数字+字母的组合，前后数字不会有进位吧？有的话这个要改 n = Asc(Replace(arr(0), sTmp, "", 1, 1)) m = Asc(Replace(arr(1), sTmp, "", 1, 1)) ReDim arr(n To m) For i = n To m arr(i) = sTmp & Chr(i) Next Else '单个字母加数字 sTmp = Left(arr(0), 1) n = Mid(arr(0), 2) m = Mid(arr(1), 2) ReDim arr(n To m) For i = n To m arr(i) = sTmp & i Next End If GetSplitString = Join(arr, ",") End Function'组合字符串Private Function GetCombString(pStr As String) As String 'pStr=CX(1-2,28,29,30)(A-E,Z Dim arrHead() As String Dim arrComb() As String Dim arrTmp() As String Dim sTmp As String Dim strHead As String Dim i As Long, j As Long Dim n As Long, m As Long, Idx As Long pStr = Replace(pStr, ")", "") 'CX(1-2,28,29,30(A-E,Z Do '组合的前项 i = InStr(pStr, "(") sTmp = Left(pStr, i - 1) pStr = Replace(pStr, sTmp & "(", "", 1, 1) arrHead = Split(sTmp, ",") n = UBound(arrHead) '组合的后段 i = InStr(pStr, "(") If i > 0 Then sTmp = Left(pStr, i - 1) pStr = Replace(pStr, sTmp, "", 1, 1) Else sTmp = pStr End If arrComb = Split(sTmp, ",") '拆分 For i = 0 To UBound(arrComb) arrComb(i) = GetSplitString(arrComb(i)) Next sTmp = Join(arrComb, ",") arrComb = Split(sTmp, ",") '拆分完成 m = UBound(arrComb) '顺序组合 ReDim arrTmp((n + 1) * (m + 1) - 1) Idx = 0 For i = 0 To UBound(arrHead) For j = 0 To UBound(arrComb) arrTmp(Idx) = Trim(arrHead(i)) & arrComb(j) Idx = Idx + 1 Next j Next i If InStr(pStr, "(") = 0 Then Exit Do Else pStr = Join(arrTmp, ",") & pStr End If Loop GetCombString = Join(arrTmp, ",") End Function'借助ADO的Recordset排序Private Function SortString(arrStr() As String) As String Dim rs As Recordset Dim i As Long Set rs = New Recordset rs.Fields.Append "FLD", adVarChar, 20 rs.Open For i = 0 To UBound(arrStr) rs.AddNew rs.Fields("FLD") = arrStr(i) rs.Update Next rs.Sort = "FLD ASC" SortString = Replace(rs.GetString, Chr(13), ",") End FunctionPrivate Sub Command1_Click() Dim s As String Dim arr() As String Dim i As Long s = " 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)" arr = Split(s, "),") For i = 0 To UBound(arr) arr(i) = GetCombString(arr(i)) Next s = Join(arr, ",") arr = Split(s, ",") s = SortString(arr) Debug.Print s End Sub
[解决办法]
R(1,2,6,7,37,42,46,47,49,50,51-53),R80(A-H）
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) 题目出的很好
假如 有这样呢？ CX(28,29,30)(A-E)（A-H）。。。。。
所以请回答者能够考虑这个通用性，另外用Vbman2003 的普通冒泡排序（字符排序）就可，不需要ADO的，如果要用ADO的话，select 语句排序即可，另外VB与VBA是基本一样的
其实最主要是如何先分理出来，其他相对很简单， SortString = Join(arrStr, ".")
join合并 那里应该是 “，”号 ，高手也有疏忽的地方，呵呵。