求教怎样将不同列中不同行的单元格内容相同的整理到同一列中去！

hbpaopao

cnko 发表于 2012-7-23 16:09
我刚用一个16列42行的数据样本测试了一下，遇到问题了，最后就乱了，并没有得到这样的效果

因为EE中不像excel有单元格的区别，所以，在排序时需要把长度超过1的内容替换为长度为1的特殊符号，这样才能保证复制回来的列号是正确的……

这个宏只是无聊的产物，之前不能用时因为宏里面输入的特殊符号太少了，不够用……现在多加了点，如果还有问题就忘了它吧，速度又慢，准确率又低=。=

cnko

hbpaopao 发表于 2012-7-23 19:36
因为EE中不像excel有单元格的区别，所以，在排序时需要把长度超过1的内容替换为长度为1的特殊符号，这样才 ...

哈哈，原来是这样，还是谢谢你啊！方法很独特，原来EE也有这样强大的功能，我用了这么久这个软件，到今天才知道呢！

香川群子

小花鹿 发表于 2012-7-23 02:23
凑个热闹：
Sub test()
Dim ar, br(), i&, j&, d

我喜欢4楼yangyangzhifeng的字典用法： 把行信息直接存入items

字典运行结束后，取出items中信息，用split方法拆分，然后填入结果数组。

具体代码写法略有不同。（我的代码稍微简洁一些）

1. Sub kagawa()
   
2.     Set d = CreateObject("Scripting.Dictionary") '定义字典d
   
3.     arr = [a1].CurrentRegion
   
4.     arr = Sheets(1).[a1].CurrentRegion '获取原始数据存入数组arr，范围可以自己修改
   
5. 
   
6.     For i = 2 To UBound(arr)
   
7.         For j = 2 To UBound(arr, 2)
   
8.             If arr(i, j) <> "" Then d(arr(i, j)) = d(arr(i, j)) & " " & i
   
9.             '按行开始逐列遍历原始数据，如果不是空格就把行信息存入item，以空格区分
   
10.         Next
    
11.     Next
    
12.    
    
13.     p = d.keys '取出字典keys的数组结果
    
14.     q = d.items '取出字典items的数组结果
    
15.     ReDim brr(1 To UBound(arr), d.Count) '定义结果数组brr
    
16.     For i = 0 To d.Count - 1 '遍历每个字典key
    
17.         s = Split(q(i)) '拆分item得到对应的行信息
    
18.         For j = 1 To UBound(s) '遍历所有对应信息（注意从1开始，因为0是空白）
    
19.             brr(s(j), i) = p(i) '直接把对应key存入结果数组中相应行
    
20.         Next
    
21.     Next
    
22.    
    
23.     [s1].Resize(UBound(arr), d.Count) = brr '输出结果到同一工作表
    
24.     Sheets(2).[a1].Resize(UBound(arr), d.Count) = brr '或输出结果到工作表2
    
25. End Sub

复制代码

建议小花鹿仔细看一看，研究一下代码写法的细节问题，对今后的代码编写，会有参考的。


呵呵。

kszcs

高手如云。学习了

香川群子

小花鹿 发表于 2012-7-23 02:23
凑个热闹：
Sub test()
Dim ar, br(), i&, j&, d

代码还可以这样改，一次循环就解决了。

1. Sub kagawa()
   
2.     Set d = CreateObject("Scripting.Dictionary") '定义字典d
   
3.    
   
4.     arr = Sheets(1).[a1].CurrentRegion '获取原始数据存入数组arr，范围可以自己修改
   
5.    
   
6.    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2)) '定义结果数组brr，和原始数据范围一样大。
   
7.     For i = 2 To UBound(arr)
   
8.         For j = 2 To UBound(arr, 2) '按行开始逐列遍历原始数据
   
9.             If arr(i, j) <> "" Then '如果不为空
   
10.                 t = d(arr(i, j)) '检查字典对应项目值(即结果数组brr中列位置序号)
    
11.                 If t = "" Then k = k + 1: d(arr(i, j)) = k: t = k
    
12.                  '如果字典中无此项目，则总序号+1，把该元素加入字典，然后列位置赋值
    
13.                 brr(i, t) = arr(i, j) '把原始数据写入结果数组中新的对应列位置。
    
14.             End If
    
15.      Next
    
16.     Next
    
17.    
    
18.     [h1].Resize(UBound(arr), d.Count) = brr '输出结果到同一工作表
    
19.    Sheets(2).[a1].Resize(UBound(arr), d.Count) = brr '或者输出结果到工作表2
    
20. End Sub
    

复制代码

小花鹿看一下这个代码算法怎么样？ 更高效、更快捷。

小花鹿

香川群子 发表于 2012-7-24 10:07
我喜欢4楼yangyangzhifeng的字典用法： 把行信息直接存入items

字典运行结束后，取出items中信息，用s ...

记住每个人在哪一行里有，将行号保存起来，以后在同一列的相应行里写入名字.................................
这种思路不知道有什么特别的优点？

小花鹿

香川群子 发表于 2012-7-24 14:56
代码还可以这样改，一次循环就解决了。小花鹿看一下这个代码算法怎么样？ 更高效、更快捷。

如果按这个思路的话，中间列号判断有点复杂了，直接这样不就行了吗？
Sub test()
Dim ar, br(), i&, j&, k&, d
Set d = CreateObject("scripting.dictionary")
ar = [b2].CurrentRegion
ReDim br(1 To UBound(ar), UBound(ar, 2))
For i = 3 To UBound(ar)
    For j = 2 To UBound(ar, 2)
        If ar(i, j) <> "" Then
            If d.exists(ar(i, j)) = 0 Then
                d(ar(i, j)) = d.Count
            End If
            br(i - 2, d(ar(i, j))) = ar(i, j)
        End If
    Next j
Next i
[j4].Resize(i - 3, d.Count) = br
End Sub

香川群子

小花鹿 发表于 2012-7-24 16:05
如果按这个思路的话，中间列号判断有点复杂了，直接这样不就行了吗？
Sub test()
Dim ar, br(), i&, j& ...

【中间列号判断有点复杂了，直接这样不就行了吗？】

从代码结果来看，你这样改当然可以。


问题是，算法就不同了。这个你能自己想明白么？


…………
而我的算法，代码看上去虽然似乎比你改写的要繁琐一点，
但是，如果数据量很大、比如2万行，几千个不同姓名（字典对象）的话，

显然我的算法在速度和内存上都有很大优势。


…………
因此，我的代码的优点，你还要好好研究。

（好的算法，不是为了让别人看得舒服，而是要让机器/电脑高效地运作。）


当然，一般情况下，好的代码算法，往往从结构上看也应该是最简单的……
但是，不能说代码结构越简单，则效率越高 → 这个是不同的含义。

牛牛苦咖啡

好难学呀，难道都这么困难吗

LMY123

将不同列中不同行的单元格内容相同的整理到同一列中去