Giúp đỡ code VBA!!!

nguyenanhdung8111982

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
tôi có file gốc như hình dưới
1585144840414.png
và sau khi copy ra file mới
1585144948386.png

Đây là code:
Mã:
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:
 

vu_tuan_manh_linh

linhvtm84@gmail.com
Tham gia ngày
27 Tháng hai 2010
Bài viết
2,459
Được thích
1,725
Điểm
860
Nơi ở
Hà Nội
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.
 

nguyenanhdung8111982

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
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

linhvtm84@gmail.com
Tham gia ngày
27 Tháng hai 2010
Bài viết
2,459
Được thích
1,725
Điểm
860
Nơi ở
Hà Nội
PHP:
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

Thành viên hoạt động
Tham gia ngày
30 Tháng năm 2008
Bài viết
105
Được thích
141
Điểm
680
Tuổi
34
Nơi ở
Quảng Trị
Tên chủ đề:
Giúp đỡ code VBA!!!
Thì cả đống
 

nguyenanhdung8111982

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
PHP:
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
 
Lần chỉnh sửa cuối:

nguyenanhdung8111982

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
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".

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

vu_tuan_manh_linh

linhvtm84@gmail.com
Tham gia ngày
27 Tháng hai 2010
Bài viết
2,459
Được thích
1,725
Điểm
860
Nơi ở
Hà Nội
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

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
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.
 
Lần chỉnh sửa cuối:

vu_tuan_manh_linh

linhvtm84@gmail.com
Tham gia ngày
27 Tháng hai 2010
Bài viết
2,459
Được thích
1,725
Điểm
860
Nơi ở
Hà Nội
Có thể giá trị đang nhận là text. Thử sửa đoạn code này:
.Offset(, 6).Value = .Value * 1
 

nguyenanhdung8111982

Thành viên mới
Tham gia ngày
1 Tháng mười một 2019
Bài viết
36
Được thích
3
Điểm
15
Tuổi
37
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
Mã:
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
 

File đính kèm

Top Bottom