Xin giúp em giải thích về code trong VBA

Liên hệ QC

xuantocdotb

Thành viên chính thức
Tham gia
1/6/16
Bài viết
66
Được thích
23
Em có biết đoạn code vừa mới sưu tầm trên GPE:
Đoạn code dùng để giãn dòng.
Mã:
Sub AutoFit()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
    Dim Cls As Range
    For Each Cls In Range("a1:a" & Range("A650").End(xlUp).Row)
        MergeCellFit Cls
    Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Em xin phép được hỏi "ngố":
Sub AutoFit() phải gắn liền với Sub MergeCellFit(ByVal MergeCells As Range) đúng không ạ?
* Tác dụng của Sub AutoFit() là như thế nào ạ?
* Tác dụng Sub MergeCellFit(ByVal MergeCells As Range) có tác dụng gì ạ?
Xin nhờ Anh-Chị giải thích giúp em vì em mới biết đến VBA .
 

File đính kèm

  • Vidu.xlsm
    347.4 KB · Đọc: 14
Em có biết đoạn code vừa mới sưu tầm trên GPE:
Đoạn code dùng để giãn dòng.
Mã:
Sub AutoFit()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
    Dim Cls As Range
    For Each Cls In Range("a1:a" & Range("A650").End(xlUp).Row)
        MergeCellFit Cls
    Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Em xin phép được hỏi "ngố":
Sub AutoFit() phải gắn liền với Sub MergeCellFit(ByVal MergeCells As Range) đúng không ạ?
* Tác dụng của Sub AutoFit() là như thế nào ạ?
* Tác dụng Sub MergeCellFit(ByVal MergeCells As Range) có tác dụng gì ạ?
Xin nhờ Anh-Chị giải thích giúp em vì em mới biết đến VBA .
Anh - Chị giải thích giúp em mới đi
 
Upvote 0
Web KT
Back
Top Bottom