Giúp đỡ code VBA!!! (1 người xem)

[nguyenanhdung8111982]

tôi có file gốc như hình dưới

và sau khi copy ra file mới


Đây là code:

Sub ProcessMultipleFiles()

    Dim NewFileName As String

    Dim FileList As Variant, FilePath As Variant

    Dim FolderPath As String



    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    FolderPath = "D:\file_csv\"

    FileList = Array("20190928.csv", "20190927.csv")

    For Each FilePath In FileList

        FilePath = FolderPath & FilePath

        If FSO.FileExists(FilePath) Then

            NewFileName = FSO.GetBaseName(FilePath)

            NewFileName = NewFileName & "_N.csv"

            FSO.CopyFile FilePath, FolderPath & NewFileName, True

            CSVAmend2 FolderPath, NewFileName

        Else

            MsgBox FilePath & " not found"

        End If

    Next FilePath

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("A2:H50000").RemoveDuplicates Columns:=6, Header:=xlYes

    'save and close

    'wb.Save

    wb.Close SaveChanges:=True                        'False
 

End Sub

Nhờ mọi người giúp đỡ chỉnh sửa code để
cột "ID" là số thứ tự tăng dần theo dòng cột A
,cột "trksegID" giá trị luôn =1
link file:

file_csv.rar

drive.google.com

 

[vu_tuan_manh_linh]

Theo tôi đoán thì cột A đã tăng số thứ tự lần lượt từ 1 đến hết, cột B đã có giá trị mặc định bằng 1. Vấn đề chỉ là định dạng thôi. Bạn cho cột A và B định dạng General là xong.

 

[befaint]

Nội quy diễn đàn

You must agree to these terms and rules before using the site.

www.giaiphapexcel.com

 

[nguyenanhdung8111982]

Theo tôi đoán thì cột A đã tăng số thứ tự lần lượt từ 1 đến hết, cột B đã có giá trị mặc định bằng 1. Vấn đề chỉ là định dạng thôi. Bạn cho cột A và B định dạng General là xong.

định dạng sao bạn, khi chạy nó ra kết quả không đúng, bạn sửa giúp mình

 

[vu_tuan_manh_linh]

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

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

    rng.Offset(, 1).Value = 1

Đoạn code này đã làm theo yêu cầu của bạn rồi. Vấn đề chỉ là ĐỊNH DẠNG SỐ.[/php]

 

[thaytu]

Tên chủ đề:
Giúp đỡ code VBA!!!
Thì cả đống

 

[nguyenanhdung8111982]

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

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

    rng.Offset(, 1).Value = 1

Đoạn code này đã làm theo yêu cầu của bạn rồi. Vấn đề chỉ là ĐỊNH DẠNG SỐ.[/php]

Dạ, nhưng em không biết định dạng sao cho ra đúng

 

[befaint]

Nội quy diễn đàn

You must agree to these terms and rules before using the site.

www.giaiphapexcel.com

 

[be_09]

Đăng bài lộn tiệm (hỏi VBA đăng trong hàm).
Tiêu đề không rõ ràng.

 

[nguyenanhdung8111982]

Đăng bài lộn tiệm (hỏi VBA đăng trong hàm).
Tiêu đề không rõ ràng.

View attachment 234037

Dạ, lỡ đăng nhầm rồi ạ

 

[nguyenanhdung8111982]

Theo tôi đoán thì cột A đã tăng số thứ tự lần lượt từ 1 đến hết, cột B đã có giá trị mặc định bằng 1. Vấn đề chỉ là định dạng thôi. Bạn cho cột A và B định dạng General là xong.

Cám ơn anh, em đã dò lại đúng là định dạng bị sai, em sửa lại chạy ra đúng rồi. A cho em hỏi thêm xíu là lúc em định dạng thời gian theo format:
"yyyy-mm-dd hh:mm:ss" thì nó hiển thị không đúng. nó vẫn hiển thị "yyyy/mm/dd hh:mm:ss". Nếu em chỉnh khoảng trắng trước năm thì hiển thị đúng " yyyy/mm/dd hh:mm:ss".

        .Formula = "=A2"
        .Value = .Value
        .Offset(, 6).Value = .Value
        .Offset(, 6).NumberFormat = "yyyy-mm-dd hh:mm:ss"

 

[vu_tuan_manh_linh]

Không hiểu ý của bạn. Đoạn code .Offset(, 6).NumberFormat = "yyyy-mm-dd hh:mm:ss" không sai gì cả.

 

[nguyenanhdung8111982]

Cột A2 ngay từ đầu nó là định dạng ngày tháng, có cách nào ngay từ đầu mình dùng công thức hay hàm nào cho nó về General không anh.

 

[vu_tuan_manh_linh]

Có thể giá trị đang nhận là text. Thử sửa đoạn code này:
.Offset(, 6).Value = .Value * 1

 

[nguyenanhdung8111982]

K

Có thể giá trị đang nhận là text. Thử sửa đoạn code này:
.Offset(, 6).Value = .Value * 1

không được anh ơi. File gốc em định dạng lại file là General. em sửa lại code

Sub ProcessMultipleFiles()

    Dim NewFileName As String

    Dim FileList As Variant, FilePath As Variant

    Dim FolderPath As String

    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    FolderPath = "C:\Users\dungna\Desktop\Vidu\"

    FileList = Array("GS033690.csv")

    For Each FilePath In FileList

        FilePath = FolderPath & FilePath

        If FSO.FileExists(FilePath) Then

            NewFileName = FSO.GetBaseName(FilePath)

            NewFileName = NewFileName & "_Heading.csv"

            FSO.CopyFile FilePath, FolderPath & NewFileName, True

            CSVAmend2 FolderPath, NewFileName

        Else

            MsgBox FilePath & " not found"

        End If

    Next FilePath

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")

    

    Set wb = Workbooks.Open(FolderPath & FileName)

    

    Set ws = wb.Sheets(1)

    Set rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))
    
        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)"
        .Value = .Value
        .Offset(, 7).Value = .Value
        .Offset(, 7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
             
         
     End With



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

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

    rng.Offset(, 1).Value = 1
  

    ws.Range("F:O").Delete Shift:=xlToLeft
    ws.Range("A1:H1").Value = headers
    ActiveSheet.Range("A1:H50000").RemoveDuplicates Columns:=6, Header:=xlYes
      
    wb.Close SaveChanges:=True                        'False
 
End Sub

Nhưng khi chạy xóa giá trị trùng chỉ giữ lại 1 nó không xóa hết giá trị trùng cột time