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

頁: [1]

zbc231 發表於 2019-12-12 11:24 PM

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

Sub 留下數字()
For i = 1 To 30
      '1.字數迴圈範圍
      s = ""
      For j = 1 To Len(Cells(i, "C"))
         '2.判斷是否為數字
         If VBA.Asc(Mid(Cells(i, "C"), j, 1)) > 47 And VBA.Asc(Mid(Cells(i, "C"), j, 1)) < 58 Then
            '3.如果是就+1
            s = s & Mid(Cells(i, "C"), j, 1)
         End If
      Next
      '4.傳給B欄i列的儲存格
      Cells(i, "B") = s
Next
Worksheets("簽到表").Range("C1:I30").ClearContents
Range("A1:B30").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlStroke, DataOption1:=xlSortNormal
End Sub第二步：為了擷取時間，利用空格將資料切成3分，為避免蓋掉剛剛擷取出的號碼，所以我先插入三行空白。
Sub insert()
With Range("B:D")
.insert xlShiftDown
.ClearFormats
End With
End Sub

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

For i = 1 To Len(Cells(1, "A"))
  ' 取得原始資料
  rawData = Cells(i, 1)

  ' 使用 Split 分割欄位
  fieldArray = Split(rawData, " ")

  ' 將各個欄位填入對應的儲存格
  For j = 0 To 2
Cells(i, j + 2).Value = fieldArray(j)
  Next j
Next i

End Sub

第四步：刪除原來的時間資料根被分割出來的前兩欄資料。
Sub delete()
Columns("A:C").Select
Selection.delete Shift:=xlToLeft
End Sub第五步：因為資料中間有跳號，所以將空號補齊。這個寫法如果開頭是4，他就會補齊4以後的空號，但1-3號就不會補，該怎麼修正才會從1號開始補齊呢？
Sub 補空號()
  Dim xRow&, xR As Range, j&, Jm&, Xm&
  xRow = .End(xlUp).Row
  If xRow = 1 Then Exit Sub
  Application.ScreenUpdating = False
  '↓檢測缺號，補足列數及填入編號
  For j = xRow - 1 To 2 Step -1
   Set xR = Range("B" & j)
   Xm = Val(xR(2)) - Val(xR)
   If Xm > 1 Then
      xR(2).Resize(Xm - 1).EntireRow.insert
      xR.AutoFill Destination:=xR.Resize(Xm), Type:=xlFillSeries
      Jm = Jm + Xm - 1
   End If
  Next j
  Application.ScreenUpdating = True
  End Sub以上為小弟目前為了擷取資料，根據網路上可找到的資訊所使用了方式，不知道各位高手能幫小弟精簡這些步驟，謝謝！

...<div class='locked'><em>瀏覽完整內容，請先 <a href='member.php?mod=register'>註冊</a> 或 <a href='javascript:;' onclick="lsSubmit()">登入會員</a></em></div><div></div>

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

本帖最後由 tryit244178 於 2019-12-27 10:09 AM 編輯

這還不簡單，你只要這樣做Public Sub Simplify()
      留下數字()
      insert()
      MySplit()
      delete()
      補空號()
End Sub你看，五個步驟就變成一個步驟了{:45:}

話說這樣東找西找，能夠湊出來，你也蠻厲害的
提供另一個給你，不過有點小缺點…不難，你可以自已寫看看Public Sub GetTimeAndSort()
Dim index As Integer

For i = 1 To 30
   index = Int(Right(Cells(i, "C"), 2))
   Worksheets("目的地").Range("A" & index) = Trim(Right(Cells(i, "A"), 8))
   Worksheets("目的地").Range("B" & index) = Cells(i, "C")
Next
End Sub因為我現在跳槽到LibreOffice，沒在用一點都不硬的Office，所以沒辦法測程式碼對不對。
如果有錯就…自已改一下XD...<div class='locked'><em>瀏覽完整內容，請先 <a href='member.php?mod=register'>註冊</a> 或 <a href='javascript:;' onclick="lsSubmit()">登入會員</a></em></div>

zbc231 發表於 2019-12-24 08:28 AM

tryit244178 發表於 2019-12-14 02:42 PM static/image/common/back.gif
這還不簡單，你只要這樣做你看，五個步驟就變成一個步驟了

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

謝謝你！我趕緊來試試看！

頁: [1]

伊莉討論區's Archiver

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