VBA :XỬ LÝ, LỌC-XÓA-SỬA VÀ LƯU FILE SCV THÀNH XLSX VỚI TÊN CHỈ ĐỊNH

 Yêu cầu: Lưu tất cả các file SCV trong thư mục thành XLSX, dưới tên ở ô A1 của mỗi file, chuyển dấu “:” trong ô A1 thành “_” để tránh lỗi, và xóa tất cả các dòng có tháng/năm khác tháng/năm được chỉ định.

Tháng/năm được chỉ định nằm ở ô A3 file xử lý.

Sub ProcessCSVFiles()

    Dim currentPath As String

    Dim fileName As String

    Dim newFileName As String

    Dim wb As Workbook

    Dim ws As Worksheet

    Dim lastRow As Long

    Dim rng As Range

    Dim cell As Range

    Dim convertedDate As Date

    Dim filterMonth As Long

    Dim filterDate As Date

    Application.ScreenUpdating = False

    currentPath = ThisWorkbook.Path

    fileName = Dir(currentPath & "\*.csv")

    Do While fileName <> ""

      Application.DisplayAlerts = False

      Set wb = Workbooks.Open(currentPath & "\" & fileName)

        newFileName = wb.Sheets(1).Range("A1").Value

        newFileName = Replace(newFileName, ":", "-")

        newFileName = currentPath & "\" & newFileName & ".xlsx"

        wb.SaveAs newFileName, FileFormat:=xlOpenXMLWorkbook

        wb.Close SaveChanges:=False

 Application.DisplayAlerts = True

 

        Set wb = Workbooks.Open(newFileName)

        Set ws = wb.Sheets(1)

        ws.Columns("A").Insert Shift:=xlToRight

 

        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

        Set rng = ws.Range("B1:B" & lastRow)

        rng.Copy ws.Range("A1")

     

        ws.Range("A3").Formula = "=IF(ISERROR(B3-1)=TRUE,DATE(RIGHT(LEFT(B3,10),4),RIGHT(LEFT(B3,5),2),LEFT(B3,2)),B3)"

        ws.Range("A3:A" & lastRow).FillDown

        ws.Range("A1:A" & lastRow).NumberFormat = "dd/mm/yyyy"

     

         ws.Range("A1:d" & lastRow).Select

        Selection.AutoFilter

filterMonth = Month(ThisWorkbook.Sheets(1).Range("A3").Value)

filterYear = Year(ThisWorkbook.Sheets(1).Range("A3").Value)

StartDate = DateSerial(filterYear, filterMonth, 1)

EndDate = DateSerial(filterYear, filterMonth + 1, 0)

ws.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=">=" & EndDate + 1, Operator:=xlOr, Criteria2:="<" & StartDate

       ws.AutoFilter.Range.Offset(1).Resize(ws.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

    ws.AutoFilterMode = False

        ws.Columns("A").Delete

     

        wb.Close SaveChanges:=True

        

    

        fileName = Dir

    Loop

       Application.ScreenUpdating = True

End Sub