Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Sub AutoMergeCenter() 'lệnh Tự động trộn ô và căn giữa
'Updateby2018.10.18
'Thiết lập các biến
Dim Rng As Range
Dim xRows As Integer
Dim WorkRng As Range
Dim i As Integer, j As Integer
Set WorkRng = Selection 'Vùng được chọn
xRows = WorkRng.Rows.Count 'Biến xác định số dòng của vùng được chọn, là giới hạn phạm vi vòng lặp
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Vòng lặp thực hiện trộn các ô liền kề giống nhau
For Each Rng In WorkRng.Columns 'Xét trên từng cột của vùng được chọn
For i = 1 To xRows - 1
For j = i + 1 To xRows
If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
Exit For 'Thoát vòng lặp khi giá trị trên cùng 1 dòng không giống nhau
End If
Next
'Thực hiện trộn vùng dữ liệu có giá trị giống nhau
WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
i = j - 1
Next
Next
WorkRng.VerticalAlignment = xlCenter 'Căn giữa cho vùng được chọn
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment