楼主
kevinchengcw |
对于下面左侧的这种成序列的数字组合,如何将其转换成右侧上方或下方的效果,下面的代码将给予解释,着注要理解的是思路,也许您还能将其简化一下:
代码如下:
- Sub test()
- Dim M, N, I As Long
- Dim Str, Tmp, Result As String
- Dim Arr
- With ActiveSheet '先排个序,这样才能从小到大集中不同的字段到一起
- .Sort.SortFields.Clear
- .Sort.SortFields.Add Key:=Range("A1:A" & .Cells(.Rows.Count, 1).End(3).Row) _
- , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- .Sort.SortFields.Add Key:=Range("B1:B" & .Cells(.Rows.Count, 1).End(3).Row) _
- , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- With .Sort
- I = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(3).Row
- .SetRange ActiveSheet.Range("A1:B" & I)
- .Header = xlGuess
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- M = 1 '设定起始的行号
- Do '开始循环
- Str = "" '串接用字符串置为空值
- I = WorksheetFunction.CountIf(Columns(1), .Cells(M, 1).Value) '判断A列当前行的值一会有几个
- If I > 1 Then '如果不止一个,则执行下面操作
- Str = .Cells(M, 2).Value '字符串等于B列当前行的值
- For N = M + 1 To M + I - 1 '循环当前行的下一行到与A列当前行值相同的行的最后一行
- If .Cells(N, 2).Value - .Cells(N, 2).Offset(-1, 0).Value = 1 Then '如果循环时的当前行的值与上一行的差为1,则
- If N <> M + I - 1 Then '如果当前行不是最后一行
- Str = Str & "-" '则字符串后串接一个连接号
- Else '否则
- Str = Str & "-" & .Cells(N, 2).Value '串接一个连接号后再接上当前行的值
- End If
- Else '如果当前行与上一行的值的差不是1
- Str = Str & "-" & .Cells(N, 2).Offset(-1, 0).Value & "," & .Cells(N, 2).Value '则串接上连接符与上一行的值及逗号加当前行的值
- End If
- Next N
- Else '如果当前行的A列值在整个序列中只有一个,则
- Str = .Cells(M, 2).Value '直接等于当前行B列的值
- End If
- '下面是后期处理得到的字符串
- Do While InStr(Str, "--") > 0 '首先将两个以上相连的"--"变成"-"
- Str = Replace(Str, "--", "-")
- Loop
- If InStr(Str, ",") > 0 Or InStr(Str, "-") > 0 Then '判断是否含有","或"-"
- Arr = Split(Str, ",") '以逗号分割放入数组
- For N = LBound(Arr) To UBound(Arr) '循环将字符串中的用"-"相连前后一样数值的项的后段替换为空
- Str = Replace(Str, "-" & Split(Arr(N), "-")(0), "")
- Next N
- For N = LBound(Arr) To UBound(Arr) '循环将字符串中"-"后面与前面相同的8位替换为空,为防止将前面的替换了,用前面连接了"-"来表明是后面的
- Str = Replace(Str, "-" & Left(Arr(N), 8), "-")
- Next N
- Arr = Split(Str, ",") '重新将替换后的字符串拆分后放入数组中
- Tmp = "" '将临时用于转换的字符串置为空
- Result = "" '用于存储结果的字符串也置为空
- For N = LBound(Arr) To UBound(Arr) '循环新的数组内容
- If Tmp = "" Or Tmp <> Left(Arr(N), 8) Then '如果临时字符串为空(开始时)或不等于数组当前项的前8位(数字差较大跳跃时),则
- Tmp = Left(Arr(N), 8) '将当前项的前8位赋值给数组
- Result = Result & ";" & Arr(N) '将当前数用分号分隔与结果字串相连接
- Else '否则
- Arr(N) = Replace(Arr(N), Tmp, "") '将前8位替换为空
- Result = Result & "," & Arr(N) '将当前数用逗号分隔与结果字串相连接
- End If
- Next N
- Result = Right(Result, Len(Result) - 1) '去掉左面的分号
- Else
- Result = .Cells(M, 2).Value '如果没有","或"-",说明是唯一一个数,直接赋值给结果字符串
- End If
- .Cells(.Rows.Count, 4).End(3).Offset(1, 0) = .Cells(M, 1).Value '写到相应的单元格位置
- .Cells(.Rows.Count, 4).End(3).Offset(0, 1) = Result
- M = M + I '跳到下一个A列不同内容的第一行
- Loop While M < .Cells(.Rows.Count, 1).End(3).Row '如果跳过后超出了最后一行的范围则结束循环
- End With
- End Sub
附示例文件.
 全码变简缩码.rar
|
