Skip to content

Instantly share code, notes, and snippets.

@DuongAQ
Created October 18, 2018 04:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save DuongAQ/1e4a48c9e4bb9bf5257e624750960482 to your computer and use it in GitHub Desktop.
Save DuongAQ/1e4a48c9e4bb9bf5257e624750960482 to your computer and use it in GitHub Desktop.
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