ExcelVBA-多列单元格中有逗号的数据整理

ExcelVBA-多列单元格中有逗号的数据整理

yhd-ExcelVBA-多列单元格中有逗号的数据整理

【问题】某天老板传来一个文件，这里有一个数据表，帮我查找一下那个是我们单位的人，他们的职务是什么？

===传来的数据===

===本单位的数据===

一般来说我们是用VlooKup函数进行查找引用，找到某人的职务，如下面

出现如下的问题

我们来看看传来的“神级”的数据，

（1）一个单元格中有两个或两个以上不等的人数

（2）分隔符号是英语的逗号”,”也有中文输入法方式的”，”逗号

我们现在要把数据整理一下，才能进行查找匹配出来，

整理要求（1）每一个单元格是一个姓名，每一个单元格是一个电话号码，（2）如果有多个姓名的，第二个姓名要对应第二个号码，第三个姓名要对应第三个号码。（3）要把中文的逗号与英文的逗号统一并且删除掉，（4）一个姓名一行，拆分后后面的“家庭编号”“家庭总人数”“家庭地址”要对应相应的人员信息中。

【解决方法】（1）如果用传统的复制===粘贴，我不敢想要做到什么时候。一次可以加班，如果明天还再传这样的文件来，那以后怎么样啊，天，我不想了，（2）请VBA上场吧

【代码测试】

（1）先把“逗号”统一成英文形式的逗号

代码如下：

Sub test_Replace()

Dim s As String

s = "岳不群,宁中则，岳灵珊"

MsgBox s

s = Replace(s, "，", ",")

MsgBox s

End Sub

（2）把统一到英文形式的符号后文本用Split函数利用逗号”,”进行分割为数组

(3)完整的代码如下：

Sub 拆分有逗号分隔的单元格数据为多行()

Dim arr, brr(), i%, j%, k%

With Sheets("传来的数据")

arr = [a1].CurrentRegion

ReDim brr(1 To UBound(arr) * 3, 1 To 6)

For i = 3 To UBound(arr)

crr = Split(Replace(arr(i, 2), "，", ","), ",")

drr = Split(Replace(arr(i, 3), "，", ","), ",")

For j = 0 To UBound(crr)

k = k + 1

brr(k, 1) = arr(i, 1)

brr(k, 2) = crr(j)

brr(k, 3) = drr(j)

brr(k, 4) = arr(i, 4)

brr(k, 5) = arr(i, 5)

brr(k, 6) = arr(i, 6)

Next j

Next i

End With

With Sheets("整理好")

.[a1].Resize(UBound(brr, 1), UBound(brr, 2)).Clear

.[c:c].NumberFormatLocal = "@"

.[a3].Resize(UBound(brr, 1), UBound(brr, 2)) = brr

.[a1:F2] = Sheets("传来的数据").[a1:F2].Value

.Range("a2:F" & .Cells(Rows.Count, 1).End(xlUp).Row).EntireColumn.AutoFit

.Range("a2:F" & .Cells(Rows.Count, 1).End(xlUp).Row).Borders.LineStyle = 1

End With

End Sub

====运行，效果如下：====

整理好了。

可以查找引用啦

完成任务