cần tạo vòng lâp cho lệnh lập lại nhiều lần (1 người xem)

[albhed]

đây là phần code mình cần viết thành vòng lập

Sub thunghiem()
sheets("Data CPK").select
Range("E3:E4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("F3:F4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("G3:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("H3:H4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

End Sub

 

[VetMini]

For Each r In Split("e3:e4,f3:f4,g3:g4,h3:h4", ",")
With Sheets("Data CPK").Range(r)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Merge
End With
Next r

 

[befaint]

Nếu có nhu cầu với nhiều cột hơn (giảm thời gian khai báo)...

Sub test()
Dim i&, col1&, col2&
col1 = Sheets("Data CPK").Columns("E").Column
col2 = Sheets("Data CPK").Columns("H").Column
For i = col1 To col2
    With Sheets("Data CPK").Range(Cells(3, i), Cells(4, i))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Merge
    End With
Next
End Sub

 

[huuthang_bd]

Nếu có nhu cầu với nhiều cột hơn (giảm thời gian khai báo)...

Sub test()
Dim i&, col1&, col2&
col1 = Sheets("Data CPK").Columns("E").Column
col2 = Sheets("Data CPK").Columns("H").Column
For i = col1 To col2
    With Sheets("Data CPK").Range(Cells(3, i), Cells(4, i))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Merge
    End With
Next
End Sub

Cái này chắc là dùng để định dạng dòng tiêu đề. Nếu đã làm thì làm cho tới luôn. Không giới hạn số dòng, không giới hạn số vùng. Chọn vùng nào làm vùng đó.

Sub MergeAndAlign()
Dim Rng As Range
For Each Rng In Selection.Columns
    With Rng
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Merge
    End With
Next
End Sub

 

[VetMini]

Tuỳ theo các bạn quan niệm thế nào là "tổng quát". Cân lưu ý rằng các giải thuật mở rộng ở #3-#4 trên đặt điều kiện các ranges cần thao tác ở vị trí liên tục nhau.

Nếu đã đặt điều kiện này thì chỉ cần chọn ô đầu tiên, và dùng Resize, Offset để tuần tự đi đến các range còn lại.

 

[huuthang_bd]

Tuỳ theo các bạn quan niệm thế nào là "tổng quát". Cân lưu ý rằng các giải thuật mở rộng ở #3-#4 trên đặt điều kiện các ranges cần thao tác ở vị trí liên tục nhau.

Nếu đã đặt điều kiện này thì chỉ cần chọn ô đầu tiên, và dùng Resize, Offset để tuần tự đi đến các range còn lại.

Không cần phải liên tục đâu bạn. Tôi đã nói là Không giới hạn số dòng, không giới hạn số vùng

 

[ndu96081631]

đây là phần code mình cần viết thành vòng lập

Sub thunghiem()
sheets("Data CPK").select
Range("E3:E4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("F3:F4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("G3:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

Range("H3:H4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Merge

End Sub

Thấy làm vầy cũng được:

Sub thunghiem()
  With Sheets("Data CPK")
    With .Range("E3:E4")
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Merge
      .Copy
    End With
    .Range("F3:H4").PasteSpecial Paste:=xlPasteFormats
  End With
  Application.CutCopyMode = False
End Sub

Tức là làm 2 cell E3:E4 rồi copy/paste format cho vùng còn lại

 

[VetMini]

Không cần phải liên tục đâu bạn. Tôi đã nói là Không giới hạn số dòng, không giới hạn số vùng

Xin lỗi tôi nói nhầm. Code #4 không merge cột.

(sửa Seclection.Columns thành Selection.Areas thì khắc phục được. Tuy nhiên, nếu 2 vùng trùng nhau 1 ô thì sẽ bị chọn cả một khoảng lớn)

 

[ndu96081631]

Thấy làm vầy cũng được:

Sub thunghiem()
  With Sheets("Data CPK")
    With .Range("E3:E4")
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Merge
      .Copy
    End With
    .Range("F3:H4").PasteSpecial Paste:=xlPasteFormats
  End With
  Application.CutCopyMode = False
End Sub

Tức là làm 2 cell E3:E4 rồi copy/paste format cho vùng còn lại

Vừa phát hiện ra có chiêu này còn lẹ hơn:

Sub thunghiem()
  With Sheets("Data CPK").Range("E3:E4,F3:F4,G3:G4,H3:H4")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
  End With
End Sub

Ẹc... Ẹc...

 

[huuthang_bd]

Xin lỗi tôi nói nhầm. Code #4 không merge cột.(sửa Seclection.Columns thành Selection.Areas thì khắc phục được. Tuy nhiên, nếu 2 vùng trùng nhau 1 ô thì sẽ bị chọn cả một khoảng lớn)

Yêu cầu ban đầu là Merge từng cột. Nếu Merge nhiều cột thì lại là câu chuyện khác.Không ai chọn những vùng chồng chéo nhau để để định dạng như vậy cả, trường hợp này chỉ sảy ra khi thao tác sai, mà thao tác sai dẫn đến kết quả sai là chuyện bình thường.

 

[albhed]

cám ơn mọi người mình đã làm được rồi

 

[VetMini]

Yêu cầu ban đầu là Merge từng cột. Nếu Merge nhiều cột thì lại là câu chuyện khác.Không ai chọn những vùng chồng chéo nhau để để định dạng như vậy cả, trường hợp này chỉ sảy ra khi thao tác sai, mà thao tác sai dẫn đến kết quả sai là chuyện bình thường.

Trong câu #5 tôi có nói "tuỳ theo quan niệm thế nào là tổng quát".
Chủ thớt hỏi làm cách nào chuyển từ một đoạn code lặp lại nhiều lần thành một vòng lặp. Và tôi trả lời như vậy trên quan điểm mỗi luợt lặp thực hiện trên một range..
Nếu muốn tìm giải thuật tối ưu cho bài toán này thì là chuyện khác hoàn toàn. Lúc ây mới phải phân tích. Cái yêu cầu "merge từng cột" là do bạn phân tích ra chứ tôi đâu có thấy trong câu hỏi #1.

 

[albhed]

thật ra phần code mình đã nêu chỉ là ví dụ thôi thật chất mình phải chạy trên 50 range và cho 2 dòng 3,4 và 5,6 nen mình chỉ sử dụng merge từng cột đến vị trí kết thúc