各位大佬,我自己胡乱搞了下。请帮忙指导,谢谢!
- Sub 匹配()
- Set d = CreateObject("scripting.dictionary")
- Set e = CreateObject("scripting.dictionary")
- Sheets("人员").Activate
- ar = [a1].CurrentRegion
- For x = 1 To UBound(ar)
- d(ar(x, 1)) = ar(x, 2)
- Next
- Sheets("代码").Activate
- ar = [a1].CurrentRegion
- For x = 1 To UBound(ar)
- e(ar(x, 1)) = ar(x, 2)
- Next
- Sheets("主表").Activate
- ar = [a1].CurrentRegion
- For x = 1 To UBound(ar)
- For Each k In d.keys
- If InStr(ar(x, 1), k) > 0 Then
- ar(x, 1) = Replace(ar(x, 1), k, d(k)) '替换人
- End If
- Next k
- For Each k In e.keys
- If InStr(ar(x, 1), k) > 0 Then
- ar(x, 1) = Replace(ar(x, 1), k, e(k)) '替换动作
- End If
- Next k
- If VBA.IsNumeric(Left(ar(x, 1), 8)) Then ar(x, 1) = Format(Left(ar(x, 1), 8), "00月00日00时00分") & Mid(ar(x, 1), 9, 99)
- If VBA.IsNumeric(Right(ar(x, 1), 1)) Then ar(x, 1) = ar(x, 1) & "万元"
- If VBA.IsNumeric(Mid(ar(x, 1), 13, 2)) Then ar(x, 1) = Left(ar(x, 1), 13) & Format(Mid(ar(x, 1), 14, 4), "00时00分") & Mid(ar(x, 1), 18, 99)
- Cells(x, 3) = ar(x, 1)
- Next x
- End Sub
复制代码 楼主,我看了之前的那个代码,的确好经典。应该是能满足你要求的,是不是你自己不会用?
|