請幫我簡化資料擷取時間並排序的步驟

zbc231

原始資料為左邊，為了擷取出時間並補空號排序，目前我用了五個步驟，因此想請問各位高手，能更簡化嗎？
目前第一步：從原始資料右邊將數字擷取出來，並排序。

1. Sub 留下數字()
   
2.     For i = 1 To 30
   
3.         '1.字數迴圈範圍
   
4.         s = ""
   
5.         For j = 1 To Len(Cells(i, "C"))
   
6.             '2.判斷是否為數字
   
7.             If VBA.Asc(Mid(Cells(i, "C"), j, 1)) > 47 And VBA.Asc(Mid(Cells(i, "C"), j, 1)) < 58 Then
   
8.                 '3.如果是就+1
   
9.                 s = s & Mid(Cells(i, "C"), j, 1)
   
10.             End If
    
11.         Next
    
12.         '4.傳給B欄i列的儲存格
    
13.         Cells(i, "B") = s
    
14.     Next
    
15.     Worksheets("簽到表").Range("C1:I30").ClearContents
    
16.     Range("A1:B30").Select
    
17. Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
    
18. OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
19. :=xlStroke, DataOption1:=xlSortNormal
    
20. End Sub

複製代碼

第二步：為了擷取時間，利用空格將資料切成3分，為避免蓋掉剛剛擷取出的號碼，所以我先插入三行空白。

1. Sub insert()
   
2. With Range("B:D")
   
3.     .insert xlShiftDown
   
4.     .ClearFormats
   
5. End With
   
6. End Sub

複製代碼

第三步：利用資料中日期、上午、時間中的空格，將資料分成3分。只是這個寫法，資料較少時，有時會跳出偵錯；沒跳出偵錯，最後兩筆資料則沒分割到，只能手動貼上。

1. Sub MySplit()
   
2. 
   
3. For i = 1 To Len(Cells(1, "A"))
   
4.   ' 取得原始資料
   
5.   rawData = Cells(i, 1)
   
6. 
   
7.   ' 使用 Split 分割欄位
   
8.   fieldArray = Split(rawData, " ")
   
9. 
   
10.   ' 將各個欄位填入對應的儲存格
    
11.   For j = 0 To 2
    
12.     Cells(i, j + 2).Value = fieldArray(j)
    
13.   Next j
    
14. Next i
    
15. 
    
16. End Sub
    

複製代碼

第四步：刪除原來的時間資料根被分割出來的前兩欄資料。

1. Sub delete()
   
2. Columns("A:C").Select
   
3. Selection.delete Shift:=xlToLeft
   
4. End Sub

複製代碼

第五步：因為資料中間有跳號，所以將空號補齊。這個寫法如果開頭是4，他就會補齊4以後的空號，但1-3號就不會補，該怎麼修正才會從1號開始補齊呢？

1. Sub 補空號()
   
2.   Dim xRow&, xR As Range, j&, Jm&, Xm&
   
3.   xRow = [B30].End(xlUp).Row
   
4.   If xRow = 1 Then Exit Sub
   
5.   Application.ScreenUpdating = False
   
6.   '↓檢測缺號，補足列數及填入編號
   
7.   For j = xRow - 1 To 2 Step -1
   
8.       Set xR = Range("B" & j)
   
9.       Xm = Val(xR(2)) - Val(xR)
   
10.       If Xm > 1 Then
    
11.         xR(2).Resize(Xm - 1).EntireRow.insert
    
12.         xR.AutoFill Destination:=xR.Resize(Xm), Type:=xlFillSeries
    
13.         Jm = Jm + Xm - 1
    
14.       End If
    
15.   Next j
    
16.   Application.ScreenUpdating = True
    
17.   End Sub

複製代碼

以上為小弟目前為了擷取資料，根據網路上可找到的資訊所使用了方式，不知道各位高手能幫小弟精簡這些步驟，謝謝！


...

瀏覽完整內容，請先 註冊 或 登入會員

zbc231

tryit244178 發表於 2019-12-14 02:42 PM

下載: 訪客無法瀏覽下載點，請先 註冊 或 登入會員

這還不簡單，你只要這樣做你看，五個步驟就變成一個步驟了

話說這樣東找西找，能夠湊出來，你也蠻厲 ...

...

瀏覽完整內容，請先 註冊 或 登入會員