Xin trợ giúp - Làm lại code cho mượt mà hơn

[haidang3245]

Nhờ các ace giúp tạo 1 cái nút cập nhật điều chỉnh giãn và ẩn hiện dòng, tương tự như file dưới. Nhưng file dưới chạy nó chậm quá vì mỗi lần qua sheet khác là phải chạy code. Mình muốn tạo 1 nút để cập nhật 1 lần. Xin cảm ơn

Private Sub Worksheet_Activate()
'Range("A4").Select
Dim Rng As Range
Dim i As Long, dongcuoi As Long, dong As Long
Application.ScreenUpdating = False
    For i = 10 To 200 'chay tu dong bat dau den ket thuc. can tu dong ian dong
        If Cells(i, 37).Value <> "" Then 'thu tu cot cuoi cung chua ham row
            dong = Cells(i, 37).Value
            If Cells(dong, 5).MergeCells = True Then MergeCellFit Cells(dong, 5) ' stt cot bat dau gop o
        End If
    Next i
    For Each Rng In [AK12:AK59 ,AK114:AK200]
      If Rng.Value <> "" Then
          Rng.EntireRow.Hidden = False
       Else
          Rng.EntireRow.Hidden = True
     End If
    Next Rng
    Call dontrang
Application.ScreenUpdating = True
' zoom100 Macro
    ActiveWindow.zoom = 100
    Range("AE4").Select
    ActiveWorkbook.save
End Sub


Sub AutoFitMerge()
     Dim lDong As Long
     Dim i As Integer
     Dim sCelldau As String
     Dim rCell As Range
     Dim NewRwH As Single, cWd As Single, MrgeWd As Single
     With Application
          .ScreenUpdating = False  'Tam dung cap nhat man hinh
          .Calculation = xlCalculationManual  'Tat cap nhat tinh toan
          .EnableEvents = False
          .DisplayAlerts = False
          .Cursor = xlWait
          .EnableCancelKey = xlErrorHandler
     End With
     lDong = ActiveCell.Row + Selection.Rows.Count
     sCelldau = ActiveCell.Address
     ActiveCell.Select
     Do Until ActiveCell.Row = lDong
          If ActiveCell.MergeCells Then
               With ActiveCell
                    .WrapText = True
                    If i = 0 Then
                         'Lay ColumnWidth cua cell dau va Tinh Tong ColumnWidth
                         For Each rCell In Selection
                              i = i + 1
                              'Lay ColumnWidth cua cell dau
                              If i = 1 Then cWd = rCell.ColumnWidth
                              'Tinh Tong ColumnWidth
                              MrgeWd = MrgeWd + rCell.ColumnWidth
                         Next
                    End If
                    Selection.MergeCells = False
                    .ColumnWidth = MrgeWd
                    .EntireRow.AutoFit
                    NewRwH = .RowHeight
                    'Tra lai ColumnWidth cua cell dau
                    .ColumnWidth = cWd
                    'MergeCells va lay Chieu cao Dong
                    With Selection
                        .MergeCells = True
                        .RowHeight = NewRwH
                    End With
               End With
          End If
          ActiveCell.Offset(1).Select
     Loop
     With Application
          .ScreenUpdating = True   'Cap nhat man hinh
          .Calculation = xlCalculationAutomatic       'Cap nhat tinh toan
          .EnableEvents = True
          .DisplayAlerts = True
          .Cursor = xlDefault
          .EnableCancelKey = xlInterrupt
     End With
     Range(sCelldau).Select
End Sub

 

[VetMini]

Bạn chịu khó đọc bài #6 ở link này:

Các địa phương thiệt hại nặng nề do bão lũ 2024

Vừa rồi các tỉnh Quảng Ninh, Hải Phòng đầu sóng ngọn gió hứng bão chịu bao thiệt hại từ bão Yagi. Nhưng hậu quả của nó còn khủng khiếp hơn nữa ở nhiều địa phương khi mưa lớn + thủy điện tàu + ta đua nhau xả lũ gây ngập lụt Đi kèm đó là lũ quét, sạt lở đất... Hà Nội dù ít bị ảnh hưởng nhưng cũng...

www.giaiphapexcel.com

Nếu thuận ý thì tìm hiểu tài khoản gởi tiền ở link này:

[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI

KÊU GỌI QUYÊN GÓP CÙNG HƯỚNG VỀ NHỮNG GIA ĐÌNH BỊ ẢNH HƯỞNG BỞI LŨ LỤT SAU BÃO SỐ 3 YAGI TẠI HUYỆN BẢO YÊN – LÀO CAI Kính gửi thành viên diễn đàn GIẢI PHÁP EXCEL.COM, Miền Bắc nước ta vừa trải qua một cơn bão lịch sử – bão số 3 Yagi đã gây ra những thiệt hại nặng nề cho nhiều vùng miền, đặc...

www.giaiphapexcel.com

Thuận ý nữa thì tự đánh giá bài của bạn ở cấp bậc nào. Nếu đúng ý thì tôi sẽ làm. Lưu ý là bản thâ\n tôi không ăn cắc bạc nào ở đây cả. Tôi làm theo tình cảm cá nhân thôi.