请教关于组合的问题!

wlianke · 发表于 2011-12-15 20:09

zhouxingyu 发表于 2011-12-15 20:04
三个字:"真漂亮"!

四个字“漂亮极啦”！

zhouxingyu · 发表于 2011-12-15 20:33

wlianke 发表于 2011-12-15 20:09
四个字“漂亮极啦”！

哈哈哈...咱们接龙呢.

zhouxingyu · 发表于 2011-12-18 20:41

香川群子发表于 2011-12-15 10:16
所有计算都是VBA内存数组运行，所以基本不受影响。

只需更改如下：

美女老师:这几天都在用你的代码,越用越觉得精妙的很,在效率上得到了大幅的提升.在此表示由衷的感谢!
还想麻烦你指教:如果有10列的数据对某一列(比如"身高"列)进行组合比较,然后连同原数据输出到Sheet2,应该怎么修改?多谢了.

香川群子 · 发表于 2011-12-19 07:57

嗯。楼主请上附件。

要有原始数据，
简单文字说明比较对象和比较规则。

如果可以，在sheet2简单地手工添几行比较结果的例子。

zhouxingyu · 发表于 2011-12-19 20:38

香川群子发表于 2011-12-19 07:57
嗯。楼主请上附件。

要有原始数据，

美女老师,附件已上.
其实就是在原来的基础上稍有变动.我的意思是想吃透你的精妙代码,现在我只是在简单的生搬硬套,没能领悟透也就不会有提高.
我知道只需要在某个部分改动下就可以达到,只是没能研究到是哪个部位.还请老师再做指点.多谢多谢!

组合.rar (10.78 KB, 下载次数: 4)

香川群子 · 发表于 2011-12-19 22:38

代码稍加改动即可。
为增加可读性，多写了几行表达中间过程。

全部代码都加了详细注释。

Sub test()
arr = [a1:c27] '原始数据范围直接赋值到数组arr
n = UBound(arr) '获取最大行数n
Set d = CreateObject("Scripting.Dictionary") '定义字典d
For i = 0 To n / 3 - 1 '在原始数据中循环遍历
j = i * 3 + 2 '获取待处理数据行位置j
t = arr(j, 2) & "," & arr(j + 1, 2) '以该行以及下一行的两个年龄作为字典关键词t
d(t) = d(t) & ";" & arr(j, 1) & "," & arr(j, 3) & ";" & arr(j + 1, 1) & "," & arr(j + 1, 3)
'对每个关键词加入相对应的性别和身高属性
Next
p = d.keys '获取字典关键词keys结果数组p
q = d.items '获取字典items结果数组q
ReDim brr(1 To n, 1 To 3) '定义结果数组brr
brr(1, 1) = "性别"
brr(1, 2) = "年龄"
brr(1, 3) = "身高"
For i = 0 To d.Count - 1 '遍历字典
k = k + 1 '序号+1，保证各年龄段隔开一行
t = Split(q(i), ";") '每个年龄段的性别及身高属性拆分
For j = 1 To UBound(t) '按拆分个数遍历
k = k + 1 '序号+1，真正的段内序号递增
brr(k, 1) = Split(t(j), ",")(0) '同一item中的性别和身高拆分，第1项为性别
brr(k, 3) = Split(t(j), ",")(1) '同一item中的性别和身高拆分，第2项为身高
brr(k, 2) = Split(p(i), ",")((k + i) Mod 2) '关键词即年龄的拆分
Next
Next
[e:g] = "" 'E-G列清空
[e1].Resize(n, 3) = brr '最终结果输出到E1开始的范围
Sheet2.[a:c] = "" 'sheet2的A-C列清空
Sheet2.[a1].Resize(n, 3) = brr '最终结果输出到sheet2的
End Sub

复制代码

zhouxingyu · 发表于 2011-12-20 00:52

香川群子发表于 2011-12-19 22:38
代码稍加改动即可。
为增加可读性，多写了几行表达中间过程。

太感谢你了,这样细致的加上注释,我就终于明白整个内涵了.
美女老师辛苦了!

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

[求助] 请教关于组合的问题!