如何将不同格数字并为同一格已逗号隔开？？？

wzyno1

如何将不同格数字并为同一格已逗号隔开？？？
77        64                    
85        5        60        
将上面并成一下格式!
77,64
85,5,60

gxuan2008

数据有点多.
不会.
跟楼主一起等答案.

alzeng

1. 
   
2. Sub conn()
   
3.     Dim icol%, irow%, str$
   
4.     For irow = 2 To [A65536].End(xlUp).Row
   
5. 
   
6.         icol = 1
   
7.         Do
   
8.             str = str & Cells(irow, icol) & ","
   
9.             If Cells(irow, icol) = "" Then
   
10.                 Exit Do
    
11.             Else
    
12.                 icol = icol + 1
    
13.             End If
    
14.         Loop
    
15. 
    
16.         Cells(irow, 16) = Left(str, Len(str) - 2)
    
17.         str = ""
    
18.     Next
    
19. End Sub
    

复制代码

gxuan2008

原帖由 alzeng 于 2009-5-18 08:40 发表

Sub conn()
    Dim icol%, irow%, str$
    For irow = 2 To [A65536].End(xlUp).Row

        icol = 1
        Do
            str = str & Cells(irow, icol) & ","
            If Cells(irow, icol)  ...

写成自定义函数是不是更好点?

zldccmx

晕，你的数据是从外面导入进来的吧。常规办法行不通，所以只好绕弯子了

1. 
   
2. Sub zldccmx()
   
3.     Arr = Sheet1.UsedRange
   
4.     ReDim Brr(1 To UBound(Arr) - 1)
   
5.     Brr = WorksheetFunction.Transpose(Brr)
   
6.     For i = 2 To UBound(Arr)
   
7.         For j = 1 To UBound(Arr, 2)
   
8.             If Len(Arr(i, j)) = 0 Then Exit For
   
9.         Next
   
10.         If j = 2 Then
    
11.             Brr(i - 1, 1) = Cells(i, 1)
    
12.         Else
    
13.             Set cel = Range(Cells(i, 1), Cells(i, j - 1))
    
14.             Brr(i - 1, 1) = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cel)), ",")
    
15.         End If
    
16.     Next
    
17.     [A2].Resize(UBound(Brr), 1) = Brr
    
18. End Sub
    

复制代码

zldccmx

类似D2：O2，里面是空的，用定位空值E却不认识，晕!
正常情况下，对于第二行，本来使用[Iv2}.end(xltoleft)返回的应该是C2，可是在本例中返回的是O2，但是Len(o2)=0

zldccmx

为减少循环，重新修改代码如下：

1. 
   
2. Sub zldccmx()
   
3.     arr = Range("a1").CurrentRegion
   
4.     Range("a1").CurrentRegion = arr
   
5.     ReDim Brr(1 To UBound(arr) - 1)
   
6.     Brr = WorksheetFunction.Transpose(Brr)
   
7.     For i = 2 To UBound(arr)
   
8.     Set cel = Range(Cells(i, 1), Cells(i, "IV").End(xlToLeft))
   
9.         If cel.Count = 1 Then
   
10.             Brr(i - 1, 1) = arr(i, 1)
    
11.         Else
    
12.             Brr(i - 1, 1) = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cel)), ",")
    
13.         End If
    
14.     Next
    
15.     [A2].Resize(UBound(Brr), 1) = Brr
    
16. End Sub
    

复制代码

alzeng

学习一下字典的用法：

1. 
   
2. Sub conn()
   
3.     Dim icol%, irow%, Dic As Object
   
4.     Set Dic = CreateObject("scripting.dictionary")
   
5. 
   
6.     For irow = 2 To [A65536].End(xlUp).Row
   
7.         icol = 1
   
8.         Do While Cells(irow, icol) > 0
   
9.             Dic.Add Cells(irow, icol), ""
   
10.             If Cells(irow, icol + 1) <> "" Then
    
11.                 icol = icol + 1
    
12.             Else
    
13.                 Exit Do
    
14.             End If
    
15.         Loop
    
16. 
    
17.         Cells(irow, 16) = Join(Dic.keys, ",")
    
18.         Dic.RemoveAll
    
19.     Next
    
20. End Sub
    

复制代码

zldccmx

原帖由 alzeng 于 2009-5-18 09:52 发表
学习一下字典的用法：
Sub conn()
    Dim icol%, irow%, Dic As Object
    Set Dic = CreateObject("scripting.dictionary")

    For irow = 2 To [A65536].End(xlUp).Row
        icol = 1
        Do Wh ...

呵呵，显然作者没有要求去除重复值，这样一来，用字典运算的结果就不符合要求。

alzeng

原帖由 zldccmx 于 2009-5-18 10:16 发表


呵呵，显然作者没有要求去除重复值，这样一来，用字典运算的结果就不符合要求。

是吗？用字典就一定要去除重复值？
zldccmx是高手，但在这一点上怕是犯错了，^_^