Nhờ giúp đỡ Macro xử lý một lần nhiều workbook!

MinhCong · 9/4/10

Kính gởi các Anh Chị Em! Tôi có vấn đề như sau cần giúp đỡ:
Do thay đổi CPU nên định dạng trang in bị thay đổi, vì vậy Tôi có ghi lại 1 cái macro để xử lý cho những sheet trong 1 workbook như sau:

Mã:

Sub Macro1()
    Const ShChon As String = ".Daomong..BT4x6..VK,CT..BT..LMau..Xay..Dien..Nuoc..TBVS..Trat..Op..Dongtran..Son..Cua..Lopmai..Langnen..Latsan."
        Dim Sh As Worksheet
        For Each Sh In Worksheets
                If InStr(ShChon, "." & Sh.Name & ".") = 0 Then GoTo Tiep
                Sh.Activate
    With ActiveSheet.PageSetup
        .RightMargin = Application.InchesToPoints(0)
    End With
    Range("46:46,91:91,136:136,181:181,226:226,271:271,316:316,361:361,406:406,451:451,496:496").Select
    Selection.Insert Shift:=xlDown
    Columns("R:R").ColumnWidth = 6
    Range("A1").Select
Tiep:
    Next Sh
End Sub

Vấn đề là Tôi có rất nhiều workbook, vậy có cách nào để chỉ cần bấm chạy macro thì tự động tất cả các workbook được lưu trong cùng 1 folder tự động chỉnh lại định dạng không?
Mong các Anh Chị Em giành chút ít thời gian giúp đỡ.
Xin cảm ơn!

Hai Lúa Miền Tây · 12/4/10

MinhCong đã viết:
Kính gởi các Anh Chị Em! Tôi có vấn đề như sau cần giúp đỡ:
Do thay đổi CPU nên định dạng trang in bị thay đổi, vì vậy Tôi có ghi lại 1 cái macro để xử lý cho những sheet trong 1 workbook như sau:

Mã:

Sub Macro1() Const ShChon As String = ".Daomong..BT4x6..VK,CT..BT..LMau..Xay..Dien..Nuoc..TBVS..Trat..Op..Dongtran..Son..Cua..Lopmai..Langnen..Latsan." Dim Sh As Worksheet For Each Sh In Worksheets If InStr(ShChon, "." & Sh.Name & ".") = 0 Then GoTo Tiep Sh.Activate With ActiveSheet.PageSetup .RightMargin = Application.InchesToPoints(0) End With Range("46:46,91:91,136:136,181:181,226:226,271:271,316:316,361:361,406:406,451:451,496:496").Select Selection.Insert Shift:=xlDown Columns("R:R").ColumnWidth = 6 Range("A1").Select Tiep: Next Sh End Sub

Vấn đề là Tôi có rất nhiều workbook, vậy có cách nào để chỉ cần bấm chạy macro thì tự động tất cả các workbook được lưu trong cùng 1 folder tự động chỉnh lại định dạng không?
Mong các Anh Chị Em giành chút ít thời gian giúp đỡ.
Xin cảm ơn!

Mình nghĩ là dùng dòng lặp mở từng file ra, chỉnh trang rồi lưu file đóng lại, bạn gửi 1 vài file mẫu xem thử nhé.

MinhCong · 13/4/10

domfootwear đã viết:
Mình nghĩ là dùng dòng lặp mở từng file ra, chỉnh trang rồi lưu file đóng lại, bạn gửi 1 vài file mẫu xem thử nhé.

Cảm ơn Bạn đã quan tâm. Mình gởi kèm file Bạn xem giúp nhé!
Cái macro Mình đã ghi ở trên để định dạng chỉnh sửa lại trang in của từng sheet cho 1 workbook rồi nhưng Mình muốn chỉ cần bấm 1 cái macro thì tất cả các workbook trong thư mục chứa nó sẽ được định dạng lại (do tất cả các workbook Mình đều định dạng như nhau cả). Bạn xem viết cho Mình cái nhé!

Hai Lúa Miền Tây · 13/4/10

MinhCong đã viết:
Cảm ơn Bạn đã quan tâm. Mình gởi kèm file Bạn xem giúp nhé!
Cái macro Mình đã ghi ở trên để định dạng chỉnh sửa lại trang in của từng sheet cho 1 workbook rồi nhưng Mình muốn chỉ cần bấm 1 cái macro thì tất cả các workbook trong thư mục chứa nó sẽ được định dạng lại (do tất cả các workbook Mình đều định dạng như nhau cả). Bạn xem viết cho Mình cái nhé!

Bạn dùng code sau thử xem coi đúng chưa nhé, xin lỗi mình chưa Test.
Mình nghĩ việc chạy định dạng này mất thời gian khá lâu đấy.

Mã:

Sub ChinhTrangIn()
On Error Resume Next
    Const ShChon As String = _
     ".Daomong..BT4x6..VK,CT..BT..LMau..Xay..Dien..Nuoc..TBVS..Trat..Op..Dongtran..Son..Cua..Lopmai..Langnen..Latsan."
    Dim sh As Worksheet
    Dim FileS As FileSearch
    Dim Wb, Wb1 As Workbook
    Dim F As Variant
    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    FPath = Wb.Path
    Set FileS = Application.FileSearch
    With FileS
        .NewSearch
        .Filename = "*.xls"
        .LookIn = Wb.Path
        .SearchSubFolders = False
        .Execute
    End With
    For Each F In Application.FileSearch.FoundFiles
        If F = Wb.FullName Then GoTo NextFile
          Workbooks.Open F
        Set Wb1 = Workbooks(Replace(F, Wb.Path & "\", ""))
          Wb1.Activate
        
       For Each sh In Worksheets
            If InStr(ShChon, "." & sh.Name & ".") = 0 Then GoTo Tiep
            sh.Activate
         With ActiveSheet.PageSetup
            .RightMargin = Application.InchesToPoints(0)
         End With
         Range("46:46,91:91,136:136,181:181,226:226,271:271,316:316,361:361,406:406,451:451,496:496").Select
         Selection.Insert Shift:=xlDown
         Columns("R:R").ColumnWidth = 6
         Range("A1").Select
Tiep:
       Next sh
    
       
Wb1.Close True
NextFile:
    Next F
    Application.ScreenUpdating = True
End Sub

ndu96081631 · 13/4/10

Ở code trên có đoạn:

Const ShChon As String = _
".Daomong..BT4x6..VK,CT..BT..LMau..Xay..Dien..Nuoc..TBVS..Trat..Op..Dongtran..Son..Cua..Lopmai..Langnen..Latsan."

tôi thấy nên là 1 array thì hay hơn ---> tìm tên sheet có tồn tại hay không trong array này, ta dùng hàm MATCH
(chứ viết như trên nhìn khá.. buồn cười)

MinhCong · 13/4/10

Bình thường thì mình chạy định dạng cho 1 workbook mất chưa tới 1 phút với macro ở trên. Bạn xem lại giúp sao nó không có chay định dạng Bạn à.
Cách dùng là mình mở hết những workbook lên hay sao vậy Bạn?

MinhCong · 13/4/10

ndu96081631 đã viết:
Ở code trên có đoạn:
tôi thấy nên là 1 array thì hay hơn ---> tìm tên sheet có tồn tại hay không trong array này, ta dùng hàm MATCH
(chứ viết như trên nhìn khá.. buồn cười)

Anh có thể giúp Em được không? Vì Em còn gà mờ mấy cái vụ này lắm.

Hai Lúa Miền Tây · 13/4/10

MinhCong đã viết:
Bình thường thì mình chạy định dạng cho 1 workbook mất chưa tới 1 phút với macro ở trên. Bạn xem lại giúp sao nó không có chay định dạng Bạn à.
Cách dùng là mình mở hết những workbook lên hay sao vậy Bạn?

Bỏ nó vào 1 file nào đó, chạy code, nó sẽ tự dò và mở tất cả các file có chưa chung 1 folder ra rồi tự nó định dạng, lưu và đóng file, tiếp tục mở file kế...

ndu96081631 · 13/4/10

MinhCong đã viết:
Anh có thể giúp Em được không? Vì Em còn gà mờ mấy cái vụ này lắm.

Thì thay dòng code trên thành:

ShChon = Array("Daomong", "BT4x6", "VK,CT", "BT", "LMau", "Xay", "Dien", "Nuoc", "TBVS", "Trat", "Op", "Dongtran", "Son", "Cua", "Lopmai", "Langnen", "Latsan")

(Ở trên khai báo Dim ShChon As Variant)
Thay dòng:

If InStr(ShChon, "." & sh.Name & ".") = 0 Then GoTo Tiep

thành:

If WorksheetFunction.Match(sh.Name, ShChon, 0) = 0 Then GoTo Tiep

MinhCong · 13/4/10

domfootwear đã viết:
Bỏ nó vào 1 file nào đó, chạy code, nó sẽ tự dò và mở tất cả các file có chưa chung 1 folder ra rồi tự nó định dạng, lưu và đóng file, tiếp tục mở file kế...

Mình chép cái macro và dán vào module của 1 workbook trong folder rồi bấm chạy. Thấy nó chạy nhưng định dạng thì không có chạy gì cả. Anh dom xem lại cái code tí nhé!

Hai Lúa Miền Tây · 13/4/10

MinhCong đã viết:
Mình chép cái macro và dán vào module của 1 workbook trong folder rồi bấm chạy. Thấy nó chạy nhưng định dạng thì không có chạy gì cả. Anh dom xem lại cái code tí nhé!

Mình bê nguyên si code của bạn vào mà, chỉ thêm là code mở file ra thôi.

MinhCong · 13/4/10

domfootwear đã viết:
Mình bê nguyên si code của bạn vào mà, chỉ thêm là code mở file ra thôi.

Code của Mình bình thường chạy định dạng cho tất cả các sheet đã chọn được mà, sao khi bỏ thêm code mở workbook vào nữa thì nó không thể chạy định dạng? Bạn xem lại có còn thiếu cái gì khi liên kết giữa 2 đoạn code này không?

Mã:

Sub ChinhTrangIn()
On Error Resume Next
    Dim Shchon As Variant
    Shchon = Array("Daomong", "BT4x6", "VK,CT", "BT", "LMau", "Xay", "Dien", "Nuoc", "TBVS", "Trat", "Op", "Dongtran", "Son", "Cua", "Lopmai", "Langnen", "Latsan")
    Dim sh As Worksheet
    Dim FileS As FileSearch
    Dim Wb, Wb1 As Workbook
    Dim F As Variant
    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    FPath = Wb.Path
    Set FileS = Application.FileSearch
    With FileS
        .NewSearch
        .Filename = "*.xls"
        .LookIn = Wb.Path
        .SearchSubFolders = False
        .Execute
    End With
    For Each F In Application.FileSearch.FoundFiles
        If F = Wb.FullName Then GoTo NextFile
          Workbooks.Open F
        Set Wb1 = Workbooks(Replace(F, Wb.Path & "\", ""))
          Wb1.Activate
          
       For Each sh In Worksheets
            If WorksheetFunction.Match(sh.Name, Shchon, 0) Then GoTo Tiep
            sh.Activate
         With ActiveSheet.PageSetup
            .RightMargin = Application.InchesToPoints(0)
         End With
         Range("46:46,91:91,136:136,181:181,226:226,271:271,316:316,361:361,406:406,451:451,496:496").Select
         Selection.Insert Shift:=xlDown
         Columns("R:R").ColumnWidth = 6
         Range("A1").Select
Tiep:
       Next sh
       
Wb1.Close True
NextFile:
    Next F
    Application.ScreenUpdating = True
End Sub

Dường như nó chỉ chạy mở cái workbook thôi, không chạy cái định dạng. Mình chạy bình thường mất thời gian cho 1 cái workbook khoảng 30s (cái code cũ), cái code mới này thì cũng thời gian cũng chỉ khoảng 30s nhưng cho khoảng 15 cái workbook (vì lý do định dạng nó không chạy).

ndu96081631 · 13/4/10

MinhCong đã viết:
Code của Mình bình thường chạy định dạng cho tất cả các sheet đã chọn được mà, sao khi bỏ thêm code mở workbook vào nữa thì nó không thể chạy định dạng? Bạn xem lại có còn thiếu cái gì khi liên kết giữa 2 đoạn code này không?

Dường như nó chỉ chạy mở cái workbook thôi, không chạy cái định dạng. Mình chạy bình thường mất thời gian cho 1 cái workbook khoảng 30s (cái code cũ), cái code mới này thì cũng thời gian cũng chỉ khoảng 30s nhưng cho khoảng 15 cái workbook (vì lý do định dạng nó không chạy).

Để thuận tiện việc kiểm tra, bạn vui lòng đưa lên đây 1 vài file mà bạn muốn định dang, cho vào chung 1 Folder nhé

MinhCong · 13/4/10

Em bỏ cái macro trong file PC1 nhé! Anh xem giúp E với.

ndu96081631 · 13/4/10

MinhCong đã viết:
Em bỏ cái macro trong file PC1 nhé! Anh xem giúp E với.

Thử sửa đoạn:
If WorksheetFunction.Match(sh.Name, Shchon, 0) Then GoTo Tiep
thành:
If WorksheetFunction.Match(sh.Name, Shchon, 0) = 0 Then GoTo Tiep
Xem thế nào nhé
Ngoài ra, để tăng tốc cho code, bạn xem cái nào ta có thể làm 1 lần cho toàn bộ sheet thì khỏi cần For Next... Ví dụ Insert dòng, cái này có thể chọn 1 lần toàn bộ các sheet rồi Insert được đấy

MinhCong · 14/4/10

ndu96081631 đã viết:
Thử sửa đoạn:
If WorksheetFunction.Match(sh.Name, Shchon, 0) Then GoTo Tiep
thành:
If WorksheetFunction.Match(sh.Name, Shchon, 0) = 0 Then GoTo Tiep
Xem thế nào nhé
Ngoài ra, để tăng tốc cho code, bạn xem cái nào ta có thể làm 1 lần cho toàn bộ sheet thì khỏi cần For Next... Ví dụ Insert dòng, cái này có thể chọn 1 lần toàn bộ các sheet rồi Insert được đấy

Cản ơn Anh, Em đã làm được rồi. Anh xem bổ sung cho Em thêm đoạn code để chạy cái định dạng này với, đoạn Em bôi màu ấy.

Mã:

Sub Macro1()
On Error Resume Next
    Dim FileS As FileSearch
    Dim Wb, Wb1 As Workbook
    Dim F As Variant
    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    FPath = Wb.Path
    Set FileS = Application.FileSearch
    With FileS
        .NewSearch
        .Filename = "*.xls"
        .LookIn = Wb.Path
        .SearchSubFolders = False
        .Execute
    End With
    For Each F In Application.FileSearch.FoundFiles
        If F = Wb.FullName Then GoTo NextFile
          Workbooks.Open F
        Set Wb1 = Workbooks(Replace(F, Wb.Path & "\", ""))
          Wb1.Activate
          
    [COLOR=Blue]Sheets(Array("Nhat ky", "Daomong", "BT4x6", "VK,CT", "BT", "LMau", "Xay", "Dien", _
        "Nuoc", "TBVS", "Trat", "Op", "Dongtran", "Son", "Cua", "Lopmai", "Langnen", "Latsan", _
        "BBXL", "KLXL", "DVSD", "TMHC")).Select
    With ActiveSheet.PageSetup
        .RightMargin = Application.InchesToPoints(0)
    End With
    Sheets(Array("Daomong", "BT4x6", "VK,CT", "BT", "LMau", "Xay", "Dien", "Nuoc", "TBVS", _
        "Trat", "Op", "Dongtran", "Son", "Cua", "Lopmai", "Langnen", "Latsan")).Select
    Range("46:46,91:91,136:136,181:181,226:226,271:271,316:316,361:361,406:406,451:451,496:496").Select
    Selection.Insert Shift:=xlDown
    Columns("R:R").ColumnWidth = 6
    Range("A1").Select[/COLOR]
    
Wb1.Close True
NextFile:
    Next F
    Application.ScreenUpdating = True
End Sub

ndu96081631 · 14/4/10

MinhCong đã viết:
Cản ơn Anh, Em đã làm được rồi. Anh xem bổ sung cho Em thêm đoạn code để chạy cái định dạng này với, đoạn Em bôi màu ấy.

Bạn cứ thí nghiệm bằng cách record macro đi
Có những cái có thể làm 1 lần trên tất cả các sheet, nhưng có những cái lại không cho phép điều này
Thí nghiệm và rút ra kết luận thôi
(Ví dụ bạn thí nghiệm Insert dòng 1 lần trên 3 sheet chẳng hạn, xem record macro nó viết thế nào)

Nhờ giúp đỡ Macro xử lý một lần nhiều workbook!

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên gắn bó

File đính kèm

❆❆❆❆❆❆❆❆

Huyền thoại GPE

Thành viên gắn bó

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Huyền thoại GPE

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Đếm ngược thời gian