数据整理

tanggu300450 · 发表于 2023-1-8 14:37

本帖最后由 tanggu300450 于 2023-1-8 14:39 编辑

求助各位大神，怎么把无序的数据整理成需要的格式

tmplinshi · 发表于 2023-1-8 20:17

本帖最后由 tmplinshi 于 2023-1-8 20:52 编辑

提取收件人信息.zip (20.53 KB, 下载次数: 11)

明天会更好zj · 发表于 2023-1-8 20:52

Sub tt()
On Error Resume Next
Dim arr(1 To 10000, 1 To 1)
n = 1
For i = 2 To Sheet1.[a65536].End(3).Row
If Left(Sheet1.Cells(i, 1), 4) = "收件地址" Then
      arr(n, 1) = Sheet1.Cells(i, 1)
      n = n + 1
Else
      arr(n - 1, 1) = arr(n - 1, 1) & Sheet1.Cells(i, 1)
End If
Next
Sheet2.Range("a2").Resize(n) = arr
For j = 1 To n
x = InStr(arr(j, 1), "收件地址")
y = InStr(arr(j, 1), "收件人")
Z = InStr(arr(j, 1), "联系电话")
Sheet2.Cells(j + 1, 2) = Mid(arr(j, 1), x + 5, y - x - 5)
Sheet2.Cells(j + 1, 4).NumberFormatLocal = "@"
Sheet2.Cells(j + 1, 4) = Mid(arr(j, 1), Z + 5)
Sheet2.Cells(j + 1, 3) = Mid(arr(j, 1), y + 4, Z - y - 4)

Next
End Sub

明天会更好zj · 发表于 2023-1-8 20:53

个别数据有问题，需要手动修改一下。

LIUZHU · 发表于 2023-1-8 22:35

规律有些乱

LIUZHU · 发表于 2023-1-9 00:53

WPSJS宏做的，这个收件人的提取写了4个正则表达式

LIUZHU · 发表于 2023-1-9 00:54

附件在此，请测试

tanggu300450 · 发表于 2023-1-9 13:34

感谢各位大神帮忙，我试试看

tanggu300450 · 发表于 2023-1-10 17:18

LIUZHU 发表于 2023-1-9 00:54
附件在此，请测试

太好用了！

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

[求助] 数据整理