EXCEL VBA内容批量转文本 员工编号姓名转员工编号 员工编号部门转员工编号姓名
Sub 转文本()
Dim a, str, s As String
Dim aa, bb, cc
Application.ScreenUpdating = False
For k = 2 To 19 '列号第几列到第几列
N1 = k '原值列
N2 = k '返回列
On Error Resume Next
For ii = 2 To 70
a = Cells(ii, N1)
Cells(ii, N2) = "'" & a
Next
Next
Application.ScreenUpdating = True
End Sub
使用前先所有单元格设置为文本格式
矩阵人员数据转换处理
Sub 通过通讯录匹配替换为工号()
Dim a, str, s As String
Dim aa, bb, cc
For k = 3 To 20 '需要处理的列范围
N1 = k '原值列
N2 = k '返回列
On Error Resume Next
Application.ScreenUpdating = False
For ii = 2 To 1932 '需要处理的行范围
a = Cells(ii, N1)
If a <> "" And Len(a) > 2 Then
aa = Split(a, ",")
str = "'"
s = ""
For I = 0 To UBound(aa)
If I > 0 Then
str = str & ";"
End If
If Len(aa(I)) < 8 And Len(aa(I)) > 2 Then
s = Application.WorksheetFunction.VLookup(aa(I), Sheet2.Range("C:G"), 2, 0)
ElseIf Len(aa(I)) < 3 Then
s = ""
Else
s = Application.WorksheetFunction.VLookup(aa(I), Sheet2.Range("A:G"), 2, False)
End If
str = str & s
Next
Cells(ii, N2) = str
Else
Cells(ii, N2) = ""
End If
Next
Next
Application.ScreenUpdating = True
'员工编号姓名 员工编号 姓名 员工编号 部门 公司 岗位
End Sub
Sub 矩阵数据转换为工号姓名()
Dim a, str, s As String
Dim aa, bb, cc
For k = 3 To 12 '需要处理的列范围
N1 = k '原值列
N2 = k '返回列
On Error Resume Next
Application.ScreenUpdating = False
For ii = 2 To 1986 '需要处理的行范围
a = Cells(ii, N1)
If a <> "" And Len(a) > 2 Then
aa = Split(a, ";")
str = "'"
s = ""
For I = 0 To UBound(aa)
If I > 0 Then
str = str & ","
End If
If Len(aa(I)) > 2 Then
s = Application.WorksheetFunction.VLookup(aa(I), Sheet3.Range("A:G"), 4, 0)
ElseIf Len(aa(I)) < 3 Then
s = ""
End If
str = str & s
Next
Cells(ii, N2) = str
End If
Next
Next
Application.ScreenUpdating = True
'姓名/部门 员工编号 姓名 员工编号姓名 部门 单位 岗位 职级
End Sub
