[已解决]如何把一列一样值得另一列值合并到表2单行数据中

zj237462623 · 发表于 2015-8-13 10:25

如何批量（有N个）的A列一样的数据对应的B列值，批量放到表2的A列对应的单个B列中。

最佳答案

爱疯

2015-8-13 11:27

Sub test()
Dim A, d, k, t, r&, i&
'Range("A1").CurrentRegion.Sort KEY1:=[A1], Order1:=xlAscending, KEY2:=[B1], Order2:=xlAscending, Header:=xlYes
With Sheets(1)
      r = .Cells(Rows.Count, 1).End(3).Row
      A = .Range("A1:b" & r)
End With
Set d = CreateObject("scripting.dictionary")
For i = 2 To r
      d(A(i, 1)) = d(A(i, 1)) & "," & A(i, 2)
Next i

k = d.keys: t = d.items
ReDim A(1 To UBound(k) + 1, 1 To 2)
For i = 1 To UBound(A)
      A(i, 1) = k(i - 1)
      A(i, 2) = Mid(t(i - 1), 2)
Next i
With Sheets(2).Range("a1")
      .CurrentRegion = ""
      .Resize(UBound(A), UBound(A, 2)) = A
End With
End Sub

如何批量已A列值的数据合并到表2单条A列对应的B列值(A)2.rar (18.02 KB, 下载次数: 6)

爱疯 · 发表于 2015-8-13 10:40

1）除了“才湾镇-白石村-上白石”，A列还有很多行，类似这样，是吗？建议A列和B列，再上传几个个数据

2）好像函数不方便实现，用VBA可以吗？

zj237462623 · 发表于 2015-8-13 11:00

爱疯发表于 2015-8-13 10:40
1）除了“才湾镇-白石村-上白石”，A列还有很多行，类似这样，是吗？建议A列和B列，再上传几个个 ...

VBA 可以呀我没用过呢呵呵
要怎么弄呢有10万的数据要分成一行一行的

爱疯 · 发表于 2015-8-13 11:27

Sub test()
Dim A, d, k, t, r&, i&
'Range("A1").CurrentRegion.Sort KEY1:=[A1], Order1:=xlAscending, KEY2:=[B1], Order2:=xlAscending, Header:=xlYes
With Sheets(1)
      r = .Cells(Rows.Count, 1).End(3).Row
      A = .Range("A1:b" & r)
End With
Set d = CreateObject("scripting.dictionary")
For i = 2 To r
      d(A(i, 1)) = d(A(i, 1)) & "," & A(i, 2)
Next i

k = d.keys: t = d.items
ReDim A(1 To UBound(k) + 1, 1 To 2)
For i = 1 To UBound(A)
      A(i, 1) = k(i - 1)
      A(i, 2) = Mid(t(i - 1), 2)
Next i
With Sheets(2).Range("a1")
      .CurrentRegion = ""
      .Resize(UBound(A), UBound(A, 2)) = A
End With
End Sub

如何批量已A列值的数据合并到表2单条A列对应的B列值(A)2.rar (18.02 KB, 下载次数: 6)

zj237462623 · 发表于 2015-8-13 11:58

爱疯发表于 2015-8-13 11:27
Sub test()
Dim A, d, k, t, r&, i&
'Range("A1").CurrentRegion.Sort KEY1:=[A1], Order1:=xlAs ...

成功了，高手非常感谢您的帮助，有了这个可以解决了很多疑难杂症

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

[已解决]如何把一列一样值得另一列值合并到表2单行数据中

相关帖子