将一维数据表转为二维数据表

APPLE123 · 发表于 2024-1-19 18:22

将一维数据表转为二维数据表

1、表1数据，从系统导出数据，原本姓名、身份证号、毕业证号、学校名称、电话号码、技术职称、就职状态等7个字段。因为系统录入不完善，个别人员没有录入电话号码和技术职称，导出数据就无法体现，如马六、赵七、张三三、马六六缺电话号码、技术职称。
2、表1数据，一般情况下，每个人员有7行，如果不完善，也许可能5行或6行，但最后一行均为“就职”。
3、表1数据，2个人员之间有一个空行，如第8、16、24行（实际工作中并未刷黄色）。
4、表1数据很多，大约有5万行。
5、想将表2数据转换为表2格式的数据，姓名、身份证号、毕业证号、学校名称、电话号码、技术职称、就职状态等7个字段各自独立为一列，详见表2。

希望vba一键获取，请老师帮忙看看，谢谢！

shiruiqiang · 发表于 2024-1-20 09:11

如果都只是缺电话号码或技术职称的话

判断空行，空行下面的写入数组，再判断内容就行

明天会更好zj · 发表于 2024-1-20 10:13

哈哈

这个效果不够理想

APPLE123 · 发表于 2024-1-20 10:53

shiruiqiang 发表于 2024-1-20 09:11
如果都只是缺电话号码或技术职称的话

判断空行，空行下面的写入数组，再判断内容就行

谢谢老师关注。
其实，数据本身采集有缺陷不规范，后期的数据使用就会有难度
但是因为涉及的数据量太大（表1数据很多，大约有5万行），无法逐一调整
可否麻烦老师帮帮忙看看如何客服这个问题，谢谢！

APPLE123 · 发表于 2024-1-20 10:57

明天会更好zj 发表于 2024-1-20 10:13
这个效果不够理想

谢谢老师的帮助。
主要是，数据本身采集有缺陷不规范，给后期的数据使用增加了难度
如能完善一下更好，谢谢！

cjc209 · 发表于 2024-1-20 11:07

没有规律就手动你这无发判断对齐列

chxw68 · 发表于 2024-1-20 11:12

Sub test()
Dim r&, i&, m&
Dim arr, brr()
Dim reg As New RegExp
With reg
.Global = True
.Pattern = "^\d+$"
End With
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:a" & r)
End With
ReDim brr(1 To 10000, 1 To 8)
m = 1
n = 2
brr(1, 1) = 1
For i = 1 To UBound(arr)
If Len(arr(i, 1)) = 0 Then
m = m + 1
brr(m, 1) = m
n = 2
Else
brr(m, n) = arr(i, 1)
n = n + 1
End If
Next
For i = 1 To m
s = 0
For j = UBound(brr, 2) To 1 Step -1
If Len(brr(i, j)) <> 0 Then
If j <> UBound(brr, 2) Then
brr(i, 8) = brr(i, j)
brr(i, j) = Empty
If Not reg.test(brr(i, 6)) Then
brr(i, 7) = brr(i, 6)
brr(i, 6) = Empty
End If
End If
Exit For
End If
Next
Next
With Worksheets("sheet2")
.UsedRange.Offset(2, 0).Clear
.Range("c:d,f:f").NumberFormatLocal = "@"
.Range("a3").Resize(m, UBound(brr, 2)) = brr
End With
End Sub

复制代码

shiruiqiang · 发表于 2024-1-20 11:13

目前只能用代码大致判断。有这个时间，不如发下去补充完整

chxw68 · 发表于 2024-1-20 11:13

参与一下。

cjc209 · 发表于 2024-1-20 11:23

chxw68

这样一样提前不对

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

[求助] 将一维数据表转为二维数据表

评分

评分