|
本帖最后由 likeyouli 于 2024-2-27 14:36 编辑
Sub wuyouchuti()
Dim t As Workbook, str, dan As Range
Set t = Workbooks.Open("D:\ming.csv") '这里根据实际更改,要求ming.csv和图片必须在同一目录。
'以下代码对ming.csv拆列,要求表格的a列为姓名,性别,工号,身份证号
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 2)), _
TrailingMinusNumbers:=True
'以下代码增加一列姓名排序,F列可实现没有重复名字的为张三_222222,有重复名字的为张三_222222_1,_2等。
Range("E1").FormulaR1C1 = "=IF(COUNTIF(C[-4],RC[-4])>1,COUNTIF(R1C1:RC[-4],RC[-4]),"""")"
Range("E1").AutoFill Destination:=Range("e1", "e" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("F1").FormulaR1C1 = "=IF(RC[-1]="""",RC[-5]&""_""&RC[-3],RC[-5]&""_""&RC[-3]&""_""&RC[-1])"
Range("F1").AutoFill Destination:=Range("F1", "F" & Cells(Rows.Count, 1).End(xlUp).Row)
str = t.Path
tu = Dir(str & "\")
Do
If tu <> "ming.csv" Then
s3 = Mid(tu, Application.Find("_", tu, Application.Find("_", tu) + 1) + 1, 18)
Set dan = ActiveSheet.UsedRange.Find(s3)
s1 = str & "\" & tu
s2 = str & "\" & dan.Offset(0, 2) & ".jpg"
Name s1 As s2
End If
tu = Dir
Loop Until tu = ""
End Sub
可实现没有重复名字的为张三_222222,有重复名字的为张三_222222_1,_2, 也就是没有重复名字的不后缀序号,有重复名字的才会后缀序号。刚测试了,没问题。
|
评分
-
查看全部评分
|