如何用VBA解决这个排序问题，请高手们帮忙！

hubulwm · 发表于 2014-2-9 15:51

原序列 (长度不确定但总是数字后面跟个汉字)
1 如 1 何 1 用 1 编 2 程 2 解决 2 这 3 个 3 排 3 序 4 问 4 题 4 请 4 高 5 手 5 们 5 查 6 看 6 帮 6 忙
想要排成的序列
1 如 2 程 3 个 4 问 5 手 6 看 1 何 2 解决 3 排 4 题 5 们 6 帮 1 用 2 这 3 序 4 请 5 查 6 忙 1 编 4 高

yjh_27 · 发表于 2014-2-9 16:27

你确定数字是1~6吗？

hubulwm · 发表于 2014-2-9 16:34

yjh_27 发表于 2014-2-9 16:27
你确定数字是1~6吗？

是数字，但有多少个不确定，也可以是1-10或其他，每个数字都有多个，且都跟着一个汉字

yjh_27 · 发表于 2014-2-9 16:44

参见附件。

yjh_27 · 发表于 2014-2-9 16:48

hubulwm 发表于 2014-2-9 16:34
是数字，但有多少个不确定，也可以是1-10或其他，每个数字都有多个，且都跟着一个汉字

总有个最大最小范围吧
对应修改数组定义

yjh_27 · 发表于 2014-2-9 16:58

自适应代码。当然输入输出位置还是要指定。

Sub aa()
Dim brr()
arr = [a2:an2]
maxi = arr(1, 1)
mini = arr(1, 1)
For i = 1 To UBound(arr, 2) Step 2
If maxi < arr(1, i) Then maxi = arr(1, i)
If mini > arr(1, i) Then mini = arr(1, i)
Next
ReDim brr(UBound(arr, 2) / 2, mini To maxi)
For i = 1 To UBound(arr, 2) Step 2
brr(0, arr(1, i)) = brr(0, arr(1, i)) + 1
brr(brr(0, arr(1, i)), arr(1, i)) = arr(1, i + 1)
Next
ii = 0
For i = 1 To UBound(brr, 1)
For j = LBound(brr, 2) To UBound(brr, 2)
If brr(0, j) > 0 Then
arr(1, 2 * ii + 1) = j
arr(1, 2 * ii + 2) = brr(i, j)
ii = ii + 1
brr(0, j) = brr(0, j) - 1
End If
Next
Next
[a5:an5] = arr
End Sub

复制代码

qy1219no2 · 发表于 2014-2-9 17:16

1、在第2行后插入一行，并在A3输入1
2、B3输入
=IF(ISNUMBER(B2),COUNTIF($A2:B2,B2),COUNTIF($A2:A2,A2))
右拉到第2行对应有数据的最后一列
3、选中第2行和第3行，复制，选中第6行，鼠标右键——选择性粘贴——数值
4、选中第6、7行，执行排序——选项——按行，关键字设置为“行7”——升序，确定，就可以得到结果。
5、删除第7行。

zax010 · 发表于 2014-2-9 19:30

请测试。

排序问题.rar (12.84 KB, 下载次数: 23)

hubulwm · 发表于 2014-2-9 19:51

本帖最后由 hubulwm 于 2014-2-9 20:50 编辑

yjh_27 发表于 2014-2-9 16:44
参见附件。

arr = [a2:an2]
{:soso_e179:}
如果把这个arr以及brr设置为变上界可变数组就好了。再用一个变量来控制这两个数组的上界，不知可否实现？

hubulwm · 发表于 2014-2-9 20:02

qy1219no2 发表于 2014-2-9 17:16
1、在第2行后插入一行，并在A3输入1
2、B3输入
=IF(ISNUMBER(B2),COUNTIF($A2:B2,B2),COUNTIF($A2:A2,A2) ...

用VBA解决且不使用其他辅助行列。（否则会破坏其他行列数据）

		自动登录	找回密码
密码			免费注册

[求助] 如何用VBA解决这个排序问题，请高手们帮忙！