Giúp công thức kiểm tra mất thời gian và thêm dòng trong vba!!!

Quảng cáo

nguyenanhdung8111982

Thành viên chính thức
Tham gia ngày
1 Tháng mười một 2019
Bài viết
53
Được thích
3
Điểm
108
Tuổi
38
tôi có đoạn code như dưới sau khi xử lý từ file gốc, nhưng khi chạy xong tôi phát hiện là thời gian bị mất không liên tục.
ví dụ như hình dưới:
9:46:20 bí mất giây 21.
9:46:25 bị mất giây 26, 27
tôi muốn thêm dòng bằng cách sao chép dòng trên và cộng thêm 1s.
Link file: https://drive.google.com/file/d/1mUcH4uzVjOPfSpOpnlDz6-_HNYnEpB_F/view?usp=sharing
Mã:
Sub ProcessMultipleFiles()
Dim FolderPath As String, FilePath As String, NewFileName As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "CSV (MS-DOS)", "*.csv"
        If .Show Then
            FolderPath = FSO.GetParentFolderName(.SelectedItems(1)) & "\"
            For i = 1 To .SelectedItems.Count
                FilePath = .SelectedItems(i)
                NewFileName = FSO.GetBaseName(FilePath)
                NewFileName = Left(NewFileName, Len(NewFileName) - 4) & "_N.csv"
                FSO.CopyFile FilePath, FolderPath & NewFileName, True
                CSVAmend2 FolderPath, NewFileName
            Next
        End If
    MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
    End With
   End Sub
   
    
Sub CSVAmend2(FolderPath As String, FileName As String)

    Dim wb As Workbook, ws As Worksheet, rng As Range, headers As Variant

    headers = Array("ID", "trksegID", "lat", "lon", "ele", "time", "time_N", "Heading")

    'open file (immediate save not needed)

    'Set wb = Workbooks.Open("D:\test_file\test\20200310_07_002_QTB_GS023662-gps.csv")

    Set wb = Workbooks.Open(FolderPath & FileName)

    'wb.SaveAs ("D:\test_file\test\20200310_07_002_QTB_GS023662.csv")

    Set ws = wb.Sheets(1)

    Set rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))
    'add time columns
         With rng.Offset(, 8)
        .Formula = "=F2"
        .Value = .Value
        .Offset(, 8).Value = .Value
        
        .Formula = "=A2"
        .Value = .Value
        .Offset(, 6).Value = .Value
         .Offset(, 6).NumberFormat = "yyyy-mm-dd hh:mm:ss"
        
        .Formula = "=A2+ TIME(7,0,0)"
        .Offset(, 7).Value = .Value
        .Offset(, 7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
      
     
    End With

    'add ID columns

    ws.Range("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    rng.Formula = "=row()-1"

    rng.Offset(, 1).Value = 1

    'delete columns not required and insert headers

    ws.Range("F:O").Delete Shift:=xlToLeft

    ws.Range("A1:H1").Value = headers

    ActiveSheet.Range("A1:H50000").RemoveDuplicates Columns:=7, Header:=xlYes

    'save and close

    'wb.Save

    wb.Close SaveChanges:=True                        'False
 

End Sub
1598012861408.png

hình kết quả mong muốn
1598013018010.png
trân trọng cám ơn!!!
 
Lần chỉnh sửa cuối:
Quảng cáo
Top Bottom