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

wzyno1 · 发表于 2009-5-18 08:16

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

gxuan2008 · 发表于 2009-5-18 08:32

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

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) = "" Then
Exit Do
Else
icol = icol + 1
End If
Loop
Cells(irow, 16) = Left(str, Len(str) - 2)
str = ""
Next
End Sub

复制代码

gxuan2008 · 发表于 2009-5-18 08:48

原帖由 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 · 发表于 2009-5-18 08:58

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

Sub zldccmx()
Arr = Sheet1.UsedRange
ReDim Brr(1 To UBound(Arr) - 1)
Brr = WorksheetFunction.Transpose(Brr)
For i = 2 To UBound(Arr)
For j = 1 To UBound(Arr, 2)
If Len(Arr(i, j)) = 0 Then Exit For
Next
If j = 2 Then
Brr(i - 1, 1) = Cells(i, 1)
Else
Set cel = Range(Cells(i, 1), Cells(i, j - 1))
Brr(i - 1, 1) = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cel)), ",")
End If
Next
[A2].Resize(UBound(Brr), 1) = Brr
End Sub

复制代码

zldccmx · 发表于 2009-5-18 09:11

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

zldccmx · 发表于 2009-5-18 09:16

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

Sub zldccmx()
arr = Range("a1").CurrentRegion
Range("a1").CurrentRegion = arr
ReDim Brr(1 To UBound(arr) - 1)
Brr = WorksheetFunction.Transpose(Brr)
For i = 2 To UBound(arr)
Set cel = Range(Cells(i, 1), Cells(i, "IV").End(xlToLeft))
If cel.Count = 1 Then
Brr(i - 1, 1) = arr(i, 1)
Else
Brr(i - 1, 1) = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(cel)), ",")
End If
Next
[A2].Resize(UBound(Brr), 1) = Brr
End Sub

复制代码

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 While Cells(irow, icol) > 0
Dic.Add Cells(irow, icol), ""
If Cells(irow, icol + 1) <> "" Then
icol = icol + 1
Else
Exit Do
End If
Loop
Cells(irow, 16) = Join(Dic.keys, ",")
Dic.RemoveAll
Next
End Sub

复制代码

zldccmx · 发表于 2009-5-18 10:16

原帖由 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 · 发表于 2009-5-18 10:26

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

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

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

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

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