Thay đổi tự động các file trong 1 folder

[dangphuong9292]

Ví dụ: trong 1 folder em có khoảng 200 file. Mỗi 1 file em đang muốn thay đổi ở Sheet 1 ô B3 và B4. e thay đổi 1 file đầu tiên còn tất cả các file tiếp theo tự động thay đổi mà không cần mở file thì Code là gì ạ. Mong các anh chị chỉ giáo ạ.

 

[snow25]

Ví dụ: trong 1 folder em có khoảng 200 file. Mỗi 1 file em đang muốn thay đổi ở Sheet 1 ô B3 và B4. e thay đổi 1 file đầu tiên còn tất cả các file tiếp theo tự động thay đổi mà không cần mở file thì Code là gì ạ. Mong các anh chị chỉ giáo ạ.

Vậy viết code mở từng file lên rồi thay đổi là xong.

 

[dangphuong9292]

Vậy viết code mở từng file lên rồi thay đổi là xong.

Như vậy vẫn phải mở từng file 1 ạ?

 

[TH2]

Như vậy vẫn phải mở từng file 1 ạ?

Không mở thì sao ghi?
Muốn thay đổi cách kê đồ trong 1 ngôi nhà, bạn phải mở cửa ngôi nhà đó (dù cách nào, mở từ xa, hay điều khiển hay mở bằng tay, đều phải mở, rồi vào thay đổi)

 

[dangphuong9292]

Không mở thì sao ghi?
Muốn thay đổi cách kê đồ trong 1 ngôi nhà, bạn phải mở cửa ngôi nhà đó (dù cách nào, mở từ xa, hay điều khiển hay mở bằng tay, đều phải mở, rồi vào thay đổi)

ý e mở nhưng nó tự động mở cũng được ạ. mở xong thay đổi xong tự tắt cũng được ạ.

 

[TH2]

ý e mở nhưng nó tự động mở cũng được ạ. mở xong thay đổi xong tự tắt cũng được ạ.

Thế thì bạn tìm kiếm bài viết về code vba nhé
mở file, thay đổi, và đóng file lại

 

[tieutuvodanh192]

Sub TEST()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim chonfile As Variant, i As Long, openfile
If MsgBox("Ban chon file can sua", vbYesNo) = vbYes Then
    chonfile = Application.GetOpenFilename(Title:="Ban chon file can sua", filefilter:="exel file(*.xls*),*.xls*", MultiSelect:=True)
    If Not IsArray(chonfile) Then Exit Sub
    For i = 1 To UBound(chonfile)
        Set openfile = Workbooks.Open(chonfile(i))
       
        Dim ws As Worksheet
        Set ws = openfile.Worksheets(1)
        ws.Range("B3:B4").Value = ... muon sua the nao tuy ban
       
    openfile.Save
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
End Sub

Bạn muốn sửa gì thì tự chế thêm nha.

 

[dangphuong9292]

Sub TEST()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim chonfile As Variant, i As Long, openfile
If MsgBox("Ban chon file can sua", vbYesNo) = vbYes Then
    chonfile = Application.GetOpenFilename(Title:="Ban chon file can sua", filefilter:="exel file(*.xls*),*.xls*", MultiSelect:=True)
    If Not IsArray(chonfile) Then Exit Sub
    For i = 1 To UBound(chonfile)
        Set openfile = Workbooks.Open(chonfile(i))
      
        Dim ws As Worksheet
        Set ws = openfile.Worksheets(1)
        ws.Range("B3:B4").Value = ... muon sua the nao tuy ban
      
    openfile.Save
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
End Sub

Bạn muốn sửa gì thì tự chế thêm nha.

có thể khi sửa xong tư động tắt file luôn k ạ

 

[TH2]

có thể khi sửa xong tư động tắt file luôn k ạ

thêm dòng code sau

openfile.Close True

Trước lệnh :
Next

 

[tieutuvodanh192]

có thể khi sửa xong tư động tắt file luôn k ạ

Mình đã suy nghĩ lại và thấy rằng việc chọn từng file để sửa và save lại như vậy khá nguy hiểm, vì click nhầm vào các file không liên quan thì khó cứu vớt, bạn có thể tham khảo thêm 1 cách khác là thiết lập luôn đường dẫn chứa các file cần chỉnh sửa thay vì chọn các file, sẽ đỡ nguy cơ hơn cách trên mình đã gửi:
Bạn thay đường dẫn chứa thư mục của bạn vào chỗ này: C:\Users\ABC\

Sub EditFiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
    MyFolder = "C:\Users\ABC\"
    MyFile = Dir(MyFolder & "*.xls*")
    Do While MyFile <> ""
        Set wb = Workbooks.Open(MyFolder & MyFile)
        wb.Sheets(1).Range("B3:B4").Value = "....muon sua gi tuy ban"
        wb.Save
        wb.Close
        MyFile = Dir()
    Loop
    MsgBox "Da xong"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[dangphuong9292]

thêm dòng code sau

openfile.Close True

Trước lệnh :

thêm dòng code sau

openfile.Close True

Trước lệnh :
Next

Mình đã suy nghĩ lại và thấy rằng việc chọn từng file để sửa và save lại như vậy khá nguy hiểm, vì click nhầm vào các file không liên quan thì khó cứu vớt, bạn có thể tham khảo thêm 1 cách khác là thiết lập luôn đường dẫn chứa các file cần chỉnh sửa thay vì chọn các file, sẽ đỡ nguy cơ hơn cách trên mình đã gửi:
Bạn thay đường dẫn chứa thư mục của bạn vào chỗ này: C:\Users\ABC\

Sub EditFiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
    MyFolder = "C:\Users\ABC\"
    MyFile = Dir(MyFolder & "*.xls*")
    Do While MyFile <> ""
        Set wb = Workbooks.Open(MyFolder & MyFile)
        wb.Sheets(1).Range("B3:B4").Value = "....muon sua gi tuy ban"
        wb.Save
        wb.Close
        MyFile = Dir()
    Loop
    MsgBox "Da xong"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

E chạy bị lỗi ạ

 

[huhumalu]

Thử dùng ADO xem.

Sub EditFiles()
    Dim MyFolder As String
    Dim MyFile As String
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    MyFolder = "C:\Users\Power Net\Desktop\hhhh\"
    MyFile = Dir(MyFolder & "*.xls*")
    conn.Provider = "Microsoft.ACE.OLEDB.12.0"
    conn.ConnectionString = "Data Source=" & MyFolder & ";Extended Properties=""Excel 12.0;HDR=No"""
    conn.Open
    Do While MyFile <> ""
        sql = "UPDATE [Sheet1$] SET F1 = '2' WHERE F2 = 'B3'" & vbCrLf & _
              "UPDATE [Sheet1$] SET F1 = '6' WHERE F2 = 'B4'"
        rs.Open sql, conn
        rs.Close
        MyFile = Dir()
    Loop
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    MsgBox "Da xong"
End Sub

Chỗ F1 = '2' và '6' tùy nội dung bạn đưa vào nhé.

 

[dangphuong9292]

thêm dòng code sau

openfile.Close True

Trước lệnh :
Next

e muốn chọn sheet được ko a.

 

[tieutuvodanh192]

View attachment 288273
E chạy bị lỗi ạ

Bạn thêm 1 dấu \ sau hhhh xem sao.
MyFolder = "C:\Users\Power Net\Desktop\hhhh\"

 

[dangphuong9292]

Mình đã suy nghĩ lại và thấy rằng việc chọn từng file để sửa và save lại như vậy khá nguy hiểm, vì click nhầm vào các file không liên quan thì khó cứu vớt, bạn có thể tham khảo thêm 1 cách khác là thiết lập luôn đường dẫn chứa các file cần chỉnh sửa thay vì chọn các file, sẽ đỡ nguy cơ hơn cách trên mình đã gửi:
Bạn thay đường dẫn chứa thư mục của bạn vào chỗ này: C:\Users\ABC\

Sub EditFiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
    MyFolder = "C:\Users\ABC\"
    MyFile = Dir(MyFolder & "*.xls*")
    Do While MyFile <> ""
        Set wb = Workbooks.Open(MyFolder & MyFile)
        wb.Sheets(1).Range("B3:B4").Value = "....muon sua gi tuy ban"
        wb.Save
        wb.Close
        MyFile = Dir()
    Loop
    MsgBox "Da xong"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

code này chạy ok rồi ạ. e cảm ơn a