Giúp đỡ code VBA!!!

Liên hệ QC

nguyenanhdung8111982

Thành viên hoạt động
Tham gia
1/11/19
Bài viết
120
Được thích
33
Giới tính
Nam
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:
 
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.
 
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
 
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]
 
Tên chủ đề:
Giúp đỡ code VBA!!!
Thì cả đống
 
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:
Đăng bài lộn tiệm (hỏi VBA đăng trong hàm).
Tiêu đề không rõ ràng.

A_Lontiem.GIF
 
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"
 
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ả.
 
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:
Có thể giá trị đang nhận là text. Thử sửa đoạn code này:
.Offset(, 6).Value = .Value * 1
 
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

  • file_dinhkem.rar
    108.2 KB · Đọc: 2
Web KT
Back
Top Bottom