Xin code định dạng (căn lề) một lần nhiều trang tính có cấu trúc giống nhau

Liên hệ QC
H

HUONGHCKT

Zalo 0986997214
Tham gia
30/8/12
Bài viết
1,707
Được thích
3,052
Donate (Paypal)
Donate
Donate (Momo)
Donate
Giới tính
Nam
Xin chào các anh chị em trong gia đình Giải pháp Excel.
Tôi có một bài muốn nhờ các anh chị em xem và hướng dẫn cho tôi
Hàng ngày tôi phải tải từ trên phần mềm xuống 1 file( chỉ có 1 sh), Cuối tháng tôi phải tổng hợp lại 30-31 cái file kia (tức 31 Sh có kết cấu giống nhau nằm ở 31 cái file), thành một file có 31 sh (mỗi Sh 1 ngày). Phần tìm kiếm theo tên file, lấy dữ liệu, tổng hợp về 1 file (xử lý số liệu,... định dạng lại các cột...), tôi đã làm được và code chạy ổn định, tốc độ cũng tạm chấp nhận được.
Xong có một phần là định dạng sheet (căn lề trái, phải, trên, dưới, xem theo chiều ngang) để chuẩn bị cho công đoạn in thì code chạy rất chậm(Đoạn code này tôi dùng Record Macro ghi lại).

Vậy muốn nhờ các anh chị em xem bài chỉ cho tôi biết tại sao code chạy chậm hoặc có cách gì để code chạy nhanh hơn thì chỉ giúp tôi với (nếu có thể sửa code cho tôi được thì càng tốt).
Xin trân trọng cảm ơn!
Mã: 
Option Explicit

Sub TongHop()

Dim Lr&, i&, j&, k&, t&, tt&, R&, C&, kk&, it&, D&, TONGN&, TONGX&
Dim Ws As Worksheet
Dim NWs As Worksheet
Dim WbMoi As Workbook
Dim KQ(), Arr(), KQCuoi()
Dim Keys As Variant, Temp
Dim Dic As Object
Dim file As Variant

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For i = 1 To 31

    Sheets("Mau").Select
    Sheets("Mau").Range("A1:Q25").Copy

                Worksheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Set NWs = ActiveSheet
                NWs.Name = "N" & i
                NWs.Range("A1").Select
                ActiveSheet.Paste
                NWs.Columns("A:A").ColumnWidth = 2.89
                NWs.Columns("B:B").ColumnWidth = 9.78
                NWs.Columns("C:C").ColumnWidth = 3.22
                NWs.Columns("D:D").ColumnWidth = 8.22
                NWs.Columns("E:E").ColumnWidth = 4.33
                NWs.Columns("F:F").ColumnWidth = 6
                NWs.Columns("G:G").ColumnWidth = 8.22
                NWs.Columns("H:H").ColumnWidth = 3.67
                NWs.Columns("I:I").ColumnWidth = 3.44
                NWs.Columns("J:J").ColumnWidth = 14
                NWs.Columns("K:K").ColumnWidth = 13
                NWs.Columns("L:L").ColumnWidth = 10.11
                NWs.Columns("M:M").ColumnWidth = 8.11
                NWs.Columns("N:N").ColumnWidth = 4.33
                NWs.Columns("O:O").ColumnWidth = 6
                NWs.Columns("P:P").ColumnWidth = 8.22
                NWs.Columns("Q:Q").ColumnWidth = 7.56
               
                NWs.Range("B13:B" & tt + 12).WrapText = True
                NWs.Range("L13:L" & tt + 12).WrapText = True
                NWs.Range("D13:D" & tt + 12).ShrinkToFit = True
                NWs.Range("M13:M" & tt + 12).ShrinkToFit = True
                NWs.Range("A" & tt + 13, "Q" & tt + 13).Font.Bold = True
'=====Đoạn này làm code chay chậm=========
    With NWs.PageSetup
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.4)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
    End With
Next i
 Call TaoMucLuc
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Đa xong"
End Sub
Trong đoạn code trên nếu vô hiệu đoạn tô đậm tho code chạy bình thường, còn không vô hiệu đoạn tô đậm đó code chạy rất ì ạch, mà tôi không hiểu tai sao.
Xem trong file đính kèm
 

File đính kèm

  • CĂN LỀ NHIỀU Sh CÙNG LÚC.xlsm
    32 KB · Đọc: 8
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
HUONGHCKT đã viết:
Xin chào các anh chị em trong gia đình Giải pháp Excel.
Tôi có một bài muốn nhờ các anh chị em xem và hướng dẫn cho tôi
Hàng ngày tôi phải tải từ trên phần mềm xuống 1 file( chỉ có 1 sh), Cuối tháng tôi phải tổng hợp lại 30-31 cái file kia (tức 31 Sh có kết cấu giống nhau nằm ở 31 cái file), thành một file có 31 sh (mỗi Sh 1 ngày). Phần tìm kiếm theo tên file, lấy dữ liệu, tổng hợp về 1 file (xử lý số liệu,... định dạng lại các cột...), tôi đã làm được và code chạy ổn định, tốc độ cũng tạm chấp nhận được.
Xong có một phần là định dạng sheet (căn lề trái, phải, trên, dưới, xem theo chiều ngang) để chuẩn bị cho công đoạn in thì code chạy rất chậm(Đoạn code này tôi dùng Record Macro ghi lại).

Vậy muốn nhờ các anh chị em xem bài chỉ cho tôi biết tại sao code chạy chậm hoặc có cách gì để code chạy nhanh hơn thì chỉ giúp tôi với (nếu có thể sửa code cho tôi được thì càng tốt).
Xin trân trọng cảm ơn!
Mã: 
Option Explicit

Sub TongHop()

Dim Lr&, i&, j&, k&, t&, tt&, R&, C&, kk&, it&, D&, TONGN&, TONGX&
Dim Ws As Worksheet
Dim NWs As Worksheet
Dim WbMoi As Workbook
Dim KQ(), Arr(), KQCuoi()
Dim Keys As Variant, Temp
Dim Dic As Object
Dim file As Variant

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For i = 1 To 31

    Sheets("Mau").Select
    Sheets("Mau").Range("A1:Q25").Copy

                Worksheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Set NWs = ActiveSheet
                NWs.Name = "N" & i
                NWs.Range("A1").Select
                ActiveSheet.Paste
                NWs.Columns("A:A").ColumnWidth = 2.89
                NWs.Columns("B:B").ColumnWidth = 9.78
                NWs.Columns("C:C").ColumnWidth = 3.22
                NWs.Columns("D:D").ColumnWidth = 8.22
                NWs.Columns("E:E").ColumnWidth = 4.33
                NWs.Columns("F:F").ColumnWidth = 6
                NWs.Columns("G:G").ColumnWidth = 8.22
                NWs.Columns("H:H").ColumnWidth = 3.67
                NWs.Columns("I:I").ColumnWidth = 3.44
                NWs.Columns("J:J").ColumnWidth = 14
                NWs.Columns("K:K").ColumnWidth = 13
                NWs.Columns("L:L").ColumnWidth = 10.11
                NWs.Columns("M:M").ColumnWidth = 8.11
                NWs.Columns("N:N").ColumnWidth = 4.33
                NWs.Columns("O:O").ColumnWidth = 6
                NWs.Columns("P:P").ColumnWidth = 8.22
                NWs.Columns("Q:Q").ColumnWidth = 7.56
              
                NWs.Range("B13:B" & tt + 12).WrapText = True
                NWs.Range("L13:L" & tt + 12).WrapText = True
                NWs.Range("D13:D" & tt + 12).ShrinkToFit = True
                NWs.Range("M13:M" & tt + 12).ShrinkToFit = True
                NWs.Range("A" & tt + 13, "Q" & tt + 13).Font.Bold = True
'=====Đoạn này làm code chay chậm=========
    With NWs.PageSetup
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.4)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
    End With
Next i
 Call TaoMucLuc
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Đa xong"
End Sub
Trong đoạn code trên nếu vô hiệu đoạn tô đậm tho code chạy bình thường, còn không vô hiệu đoạn tô đậm đó code chạy rất ì ạch, mà tôi không hiểu tai sao.
Xem trong file đính kèm
Nhấp chuột vào đây để mở rộng...
Định dạng sheet "Mau" đúng chuẩn copy ra 31 sheet và không định dạng lại
 
Upvote 0
HUONGHCKT đã viết:
Xin chào các anh chị em trong gia đình Giải pháp Excel.
Tôi có một bài muốn nhờ các anh chị em xem và hướng dẫn cho tôi
Hàng ngày tôi phải tải từ trên phần mềm xuống 1 file( chỉ có 1 sh), Cuối tháng tôi phải tổng hợp lại 30-31 cái file kia (tức 31 Sh có kết cấu giống nhau nằm ở 31 cái file), thành một file có 31 sh (mỗi Sh 1 ngày). Phần tìm kiếm theo tên file, lấy dữ liệu, tổng hợp về 1 file (xử lý số liệu,... định dạng lại các cột...), tôi đã làm được và code chạy ổn định, tốc độ cũng tạm chấp nhận được.
Xong có một phần là định dạng sheet (căn lề trái, phải, trên, dưới, xem theo chiều ngang) để chuẩn bị cho công đoạn in thì code chạy rất chậm(Đoạn code này tôi dùng Record Macro ghi lại).

Vậy muốn nhờ các anh chị em xem bài chỉ cho tôi biết tại sao code chạy chậm hoặc có cách gì để code chạy nhanh hơn thì chỉ giúp tôi với (nếu có thể sửa code cho tôi được thì càng tốt).
Xin trân trọng cảm ơn!
Mã: 
Option Explicit

Sub TongHop()

Dim Lr&, i&, j&, k&, t&, tt&, R&, C&, kk&, it&, D&, TONGN&, TONGX&
Dim Ws As Worksheet
Dim NWs As Worksheet
Dim WbMoi As Workbook
Dim KQ(), Arr(), KQCuoi()
Dim Keys As Variant, Temp
Dim Dic As Object
Dim file As Variant

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For i = 1 To 31

    Sheets("Mau").Select
    Sheets("Mau").Range("A1:Q25").Copy

                Worksheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Set NWs = ActiveSheet
                NWs.Name = "N" & i
                NWs.Range("A1").Select
                ActiveSheet.Paste
                NWs.Columns("A:A").ColumnWidth = 2.89
                NWs.Columns("B:B").ColumnWidth = 9.78
                NWs.Columns("C:C").ColumnWidth = 3.22
                NWs.Columns("D:D").ColumnWidth = 8.22
                NWs.Columns("E:E").ColumnWidth = 4.33
                NWs.Columns("F:F").ColumnWidth = 6
                NWs.Columns("G:G").ColumnWidth = 8.22
                NWs.Columns("H:H").ColumnWidth = 3.67
                NWs.Columns("I:I").ColumnWidth = 3.44
                NWs.Columns("J:J").ColumnWidth = 14
                NWs.Columns("K:K").ColumnWidth = 13
                NWs.Columns("L:L").ColumnWidth = 10.11
                NWs.Columns("M:M").ColumnWidth = 8.11
                NWs.Columns("N:N").ColumnWidth = 4.33
                NWs.Columns("O:O").ColumnWidth = 6
                NWs.Columns("P:P").ColumnWidth = 8.22
                NWs.Columns("Q:Q").ColumnWidth = 7.56
              
                NWs.Range("B13:B" & tt + 12).WrapText = True
                NWs.Range("L13:L" & tt + 12).WrapText = True
                NWs.Range("D13:D" & tt + 12).ShrinkToFit = True
                NWs.Range("M13:M" & tt + 12).ShrinkToFit = True
                NWs.Range("A" & tt + 13, "Q" & tt + 13).Font.Bold = True
'=====Đoạn này làm code chay chậm=========
    With NWs.PageSetup
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.4)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
    End With
Next i
 Call TaoMucLuc
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Đa xong"
End Sub
Trong đoạn code trên nếu vô hiệu đoạn tô đậm tho code chạy bình thường, còn không vô hiệu đoạn tô đậm đó code chạy rất ì ạch, mà tôi không hiểu tai sao.
Xem trong file đính kèm
Nhấp chuột vào đây để mở rộng...
Sao ngó cồng kềnh nhỉ, thì vậy là được thôi mà:
Mã: 
Sub TaoSheet()
Dim i As Long
For i = 1 To 31
    Sheets("Mau").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    ActiveSheet.Name = "N" & i
Next
End Sub

Bạn thêm điều kiện nếu sheet đã tồn tại thì xóa hay làm gì này nọ nữa nha
 
Upvote 0
HieuCD đã viết:
Định dạng sheet "Mau" đúng chuẩn copy ra 31 sheet và không định dạng lại
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh đã quan tâm.
Không biết tôi làm có đúng không nhưng sau khi tao Sh mới thì định dạng các cột của Sh vẫn không theo như sh Mau. và cứ vẫn theo mặc định của máy. Còn cái khúc With NWs.PageSetup....... cứ thêm vào là chạy ì ạch và tôi cũng không biết làm cách nào để căn chỉnh lề lại các mặc định của Excel.
Bài đã được tự động gộp:

Nhattanktnn đã viết:
Sao ngó cồng kềnh nhỉ, thì vậy là được thôi mà:
Mã: 
Sub TaoSheet()
Dim i As Long
For i = 1 To 31
    Sheets("Mau").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    ActiveSheet.Name = "N" & i
Next
End Sub

Bạn thêm điều kiện nếu sheet đã tồn tại thì xóa hay làm gì này nọ nữa nha
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn đã quan tâm xem bài và chỉ giáo, Như tôi đã nói, tôi phải tải về 31 cái file (1Sh/file (tạm gọi là Sh Nguon) copy sh Nguon ấy và paste và file Tonghop từng sh một (Sh Dich), sau đó xử lý số liệu trên Sh Dich, thêm bớt.... định dạng và in. Tôi cũng đã làm theo cách như anh đã bày, nhưng không hiểu sao là không paste được, khi thì báo lỗi ở dòng Sheets("Nguon").copy after, khi thì nó paste cái Sh Nguôn đầu tiên.
Một lần nữa xin được cảm ơn Anh HieuCD và Anh Nhattantnn, bằng sự chỉ bảo của các anh tôi đã làm lại và thành công
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
Code Lọc Dữ Liệu
Trả lời
2
Đọc
47
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
68
hoangminhtien
hoangminhtien
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
4
Đọc
90
Tuấn Bụng Bự
Tuấn Bụng Bự
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
124
ptm0412
ptm0412
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
12
Đọc
19K
cantl
C
N
Giúp sửa mã code
Trả lời
4
Đọc
90
ptm0412
ptm0412
Nguyencaocuong86
Tô màu dữ liệu trùng lặp trong excel.
Trả lời
10
Đọc
112
Nguyencaocuong86
Nguyencaocuong86
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
0
Đọc
26
zarra
zarra
Hoangquyenbong
  • Question
Nhờ viết code lọc dữ liệu tại các sheet khác nhau.
Trả lời
12
Đọc
132
Hoangquyenbong
Hoangquyenbong
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
10 11 12
Trả lời
236
Đọc
12K
Ryder
Ryder
D
Giúp em công thức lấy mã vật tư gồm 14 số?
Trả lời
3
Đọc
78
hoangminhtien
hoangminhtien
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.43 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
48
Đọc
21K
HeSanbi
HeSanbi
dunghtgiga
Tính bốn tuần cho một tháng
Trả lời
8
Đọc
215
cantl
C
L
Dùng vlookup đưa kết quả không được
Trả lời
19
Đọc
292
họ nguyễn tên thùy
họ nguyễn tên thùy
Ha Manh-LD
Thêm dòng cho 2 bảng cùng lúc
Trả lời
0
Đọc
42
Ha Manh-LD
Ha Manh-LD
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
1
Đọc
119
Hoàng Tuấn 868
H
T
Ký tự đặc biệt đại diện cho các ký tự khác trong vba là gì
Trả lời
7
Đọc
252
VetMini
V
N
Tạo, sử dụng Automation Add-in trong Excel bằng Visual C#
    • Thích
    • Yêu thích
Trả lời
19
Đọc
1K
dovandung
D
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
6
Đọc
240
Decepticon
D
keandanh141
Hướng dẫn hàm số tạo số ngẫu nhiên sao cho tổng bằng đúng 1 số
Trả lời
9
Đọc
223
CHAOQUAY
C
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom