[need help] rút gọn code vba (1 người xem)

[mhieuit]

Dear GPE,
em có đoạn code như bên dưới, nhưng mọi khi chạy code này thì chạy rất lâu (nếu có trên 50 sheets), anh/chị có cách nào làm cho đoạn code này chạy nhanh không ạ, vì file của em có khi có hơn 100 sheets lận

Thanks all.

[CODE]Private Sub SetDN()Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
For i = 1 To Sheets.Count
    Sheets(i).Columns("C").EntireColumn.Hidden = True
    Sheets(i).Columns("D").EntireColumn.Hidden = True
    Sheets(i).Columns("Q").EntireColumn.Hidden = True
    Sheets(i).Columns("R").EntireColumn.Hidden = True
    Sheets(i).Columns("T").ColumnWidth = 10
    Sheets(i).Columns("W").ColumnWidth = 10
    Sheets(i).Range("A16:A100").RowHeight = 25
        With Sheets(i).PageSetup
            .Zoom = 95
            .RightHeader = "Page &P of &N"
            .PrintTitleRows = "$1:$15"
            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(0.1)
            .BottomMargin = Application.InchesToPoints(0.1)
        End With
Next i
' Promt
    strPrompt = "Done Set Page, OK?"
 
    ' Dialog's Title
    strTitle = "Information"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbOKOnly, strTitle)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/CODE]

 

[Quang_Hải]

Dear GPE,
em có đoạn code như bên dưới, nhưng mọi khi chạy code này thì chạy rất lâu (nếu có trên 50 sheets), anh/chị có cách nào làm cho đoạn code này chạy nhanh không ạ, vì file của em có khi có hơn 100 sheets lận

Thanks all.

[CODE]Private Sub SetDN()Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
For i = 1 To Sheets.Count
    Sheets(i).Columns("C").EntireColumn.Hidden = True
    Sheets(i).Columns("D").EntireColumn.Hidden = True
    Sheets(i).Columns("Q").EntireColumn.Hidden = True
    Sheets(i).Columns("R").EntireColumn.Hidden = True
    Sheets(i).Columns("T").ColumnWidth = 10
    Sheets(i).Columns("W").ColumnWidth = 10
    Sheets(i).Range("A16:A100").RowHeight = 25
        With Sheets(i).PageSetup
            .Zoom = 95
            .RightHeader = "Page &P of &N"
            .PrintTitleRows = "$1:$15"
            .LeftMargin = Application.InchesToPoints(0.5)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(0.1)
            .BottomMargin = Application.InchesToPoints(0.1)
        End With
Next i
' Promt
    strPrompt = "Done Set Page, OK?"
 
    ' Dialog's Title
    strTitle = "Information"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbOKOnly, strTitle)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/CODE]

Thử vầy coi sao. Chưa test code nha.

Sub SetDN()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
Sheets.Select
With Sheets(1)
    .Columns("C").EntireColumn.Hidden = True
    .Columns("D").EntireColumn.Hidden = True
    .Columns("Q").EntireColumn.Hidden = True
    .Columns("R").EntireColumn.Hidden = True
    .Columns("T").ColumnWidth = 10
    .Columns("W").ColumnWidth = 10
    .Range("A16:A100").RowHeight = 25
   With .PageSetup
      .Zoom = 95
      .RightHeader = "Page &P of &N"
      .PrintTitleRows = "$1:$15"
      .LeftMargin = Application.InchesToPoints(0.5)
      .RightMargin = Application.InchesToPoints(0.1)
      .TopMargin = Application.InchesToPoints(0.1)
      .BottomMargin = Application.InchesToPoints(0.1)
   End With
End With
' Promt
    strPrompt = "Done Set Page, OK?"
 
    ' Dialog's Title
    strTitle = "Information"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbOKOnly, strTitle)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[mhieuit]

Thử vầy coi sao. Chưa test code nha.

Sub SetDN()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
Sheets.Select
With Sheets(1)
    .Columns("C").EntireColumn.Hidden = True
    .Columns("D").EntireColumn.Hidden = True
    .Columns("Q").EntireColumn.Hidden = True
    .Columns("R").EntireColumn.Hidden = True
    .Columns("T").ColumnWidth = 10
    .Columns("W").ColumnWidth = 10
    .Range("A16:A100").RowHeight = 25
   With .PageSetup
      .Zoom = 95
      .RightHeader = "Page &P of &N"
      .PrintTitleRows = "$1:$15"
      .LeftMargin = Application.InchesToPoints(0.5)
      .RightMargin = Application.InchesToPoints(0.1)
      .TopMargin = Application.InchesToPoints(0.1)
      .BottomMargin = Application.InchesToPoints(0.1)
   End With
End With
' Promt
    strPrompt = "Done Set Page, OK?"
 
    ' Dialog's Title
    strTitle = "Information"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbOKOnly, strTitle)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

DEAR ANH,
code cuả anh bỏ vòng lập đúng không anh? vì thế code chi áp dụng cho 1 sheet hiện tại còn các sheets còn lại không có tác dụng của code, anh check lại giúp em nhé, em gửi file att nhé
anh ơi có thể thay dòng này

Range("A16:A100").RowHeight = 25

bằng 1 code khác được không anh (vùng bắt đầu set rowheight từ A16 đến hết dữ liệu)
note: code này em áp dụng tất cả các sheets