[發問] 有問題請教>"<

本帖最後由 GBKEE 於 2014-12-21 16:30 編輯

主管心血來潮，要我把公司員工的資料從新整理....

因為新舊員工編號的問題，讓小妹我冷汗直流....

全部資料大約有2千多筆....不可能一個一個對吧!!

請各位神大解救我><"

範例如下:

舊的編號為100300661007091 要編成新的編號為10030019661007091N

資料內新舊員工參雜，不知如何更改...

初出茅廬的小女子

der寶寶

小學生 Rank: 1

帖子: 3
主題: 1
精華: 0
積分: 5
點名: 0
作業系統: WIN8
軟體版本: OFFICE2010
閱讀權限: 10
性別: 女
註冊時間: 2014-12-21
最後登錄: 2014-12-23

5^#

發表於 2014-12-23 23:03 | 只看該作者

回復 4# chihminyang88

感謝大大幫忙，但..有點太專業了

小妹我去找到了=REPLACE這個函數，有點蠻無腦的，但也算完成工作了-.-!!

初出茅廬的小女子

TOP

chihminyang88

中學生 Rank: 2

帖子: 33
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: win10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2013-3-10
最後登錄: 2024-2-7

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2014-12-22 08:45 | 只看該作者

抱歉! 沒注意您的權限
將G1輸入數字即可啟動程式

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
      Dim I As Long
      Dim J As Long

      Application.ScreenUpdating = False
      Call LASTCell(J)
  For I = 2 To J
If Len(Sheets("SHEET1").Range("C" & I)) = 18 Or Right(Sheets("SHEET1").Range("C" & I), 1) = "N" Then
   Sheets("SHEET1").Range("D" & I) = "新"
End If

If Len(Sheets("SHEET1").Range("C" & I)) = 15 Then
   Sheets("SHEET1").Range("D" & I) = "舊"

   If Sheets("SHEET1").Range("A" & I) <> Sheets("SHEET1").Range("A" & I + 1) Then
   Call INSERT(I)
   Sheets("SHEET1").Range("A" & I + 1 & ":D" & I + 1).Value = Sheets("SHEET1").Range("A" & I & ":D" & I).Value
   Sheets("SHEET1").Range("C" & I + 1) = Left(Sheets("SHEET1").Range("C" & I), 6) & "19" & Right(Sheets("SHEET1").Range("C" & I), 9) & "N"
   Sheets("SHEET1").Range("D" & I + 1) = "新"
   I = I + 1
   J = J + 1
   End If
End If
  Next
End If
End Sub
Sub LASTCell(J As Long)
   With Sheets("SHEET1").Range("A:A")
      Set X = .Find(What:="", After:=.Cells(.Cells.Count), _
         LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
      If Not X Is Nothing Then J = X.Row + 2
   End With
End Sub
Sub INSERT(I As Long)
'
Rows(I + 1 & ":" & I + 1).Select
Selection.INSERT Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

執行前.jpg (211.91 KB)