Tạo macro gộp tiêu đề của nhiều cell lại thành 1cell

[timhieu02]

Em nhờ các anh chị làm dùm em 1 macro để gộp các tiêu đề bị nhảy qua cell khác.em gửi file đính kèm trước khi gộp lai và 1 file đính kèm sau khi đã gộp.giúp dùm em.

 

[huuthang_bd]

Em nhờ các anh chị làm dùm em 1 macro để gộp các tiêu đề bị nhảy qua cell khác.em gửi file đính kèm trước khi gộp lai và 1 file đính kèm sau khi đã gộp.giúp dùm em.

Cái này đâu phải chỉ là gộp, có ô còn mất khoảng trống giữa hai chữ. Nếu tất cả các tiêu đề điều giống nhau thì tốt nhất thì tạo một cái tiêu đề mẫu và copy và dán vào.

 

[timhieu02]

Nếu giống nhau thì đâu có khó.bởi vậy mình mới cần macro.Tại vì dữ liệu dài lắm,nên không copy dán được.

 

[vu_tuan_manh_linh]

Nếu giống nhau thì đâu có khó.bởi vậy mình mới cần macro.Tại vì dữ liệu dài lắm,nên không copy dán được.

Macro chỉ cho ra kết quả đúng nếu dữ liệu đồng nhất. Nếu các tiêu đề của bạn không giống nhau thì khó nhận biết chúng mà chạy macro được.

 

[huuthang_bd]

Nếu giống nhau thì đâu có khó.bởi vậy mình mới cần macro.Tại vì dữ liệu dài lắm,nên không copy dán được.

Dữ liệu của bạn nếu bị cắt giữa 2 từ thì khi ghép lại sẽ bị mất khoảng trắng. Nếu muốn thêm khoản trắng vào thì chỉ có cách tìm bằng mắt và làm bằng tay, Macro không làm được.

 

[timhieu02]

Không làm macro được ah.Dưới mỗi tiêu đề mình đều có ký tự bắt đầu là "*------"chỉ merge tiêu đề 2 cell lại thành 1.Không có cách nào ah.

 

[huuthang_bd]

Không làm macro được ah.Dưới mỗi tiêu đề mình đều có ký tự bắt đầu là "*------"chỉ merge tiêu đề 2 cell lại thành 1.Không có cách nào ah.

Bạn xem nhé:
Trường hợp 1:
Ta có Loca và tion ghép lại ta được Location. Cái này đúng.
Trường hợp 2:
Ta có Types of và customers ghép lại ta được Types ofcustomers. Cái này thì không đúng, phải là Types of customers (theo như kết quả mẫu của bạn).

Khoảng trắng sẽ bị mất nếu nó nằm ngay chỗ bị cắt.

 

[timhieu02]

Ah,mình lộn rồi phải là Types of customers.Vậy là bạn làm được phải không.Giúp mình nha.Thanks

 

[huuthang_bd]

Ah,mình lộn rồi phải là Types of customers.Vậy là bạn làm được phải không.Giúp mình nha.Thanks

Hình như bạn chưa hiểu ý tôi. Bạn hãy xem lại file của mình và bài trả lời của tôi.

 

[timhieu02]

Vậy là không cách nào tạo macro ah.nếu macro chạy ra types ofcustomers thì cũng đựơc.Mình chỉ cần kiểm tra cái phần đầu tiên cái nào không đúng mình replace lại.

 

[huuthang_bd]

Vậy là không cách nào tạo macro ah.nếu macro chạy ra types ofcustomers thì cũng đựơc.Mình chỉ cần kiểm tra cái phần đầu tiên cái nào không đúng mình replace lại.

Hình như bạn có nói là các tiêu đề không giống nhau.

Nếu giống nhau thì đâu có khó.bởi vậy mình mới cần macro.Tại vì dữ liệu dài lắm,nên không copy dán được.

Vậy không biết bạn sẽ Replace bằng cách nào???

 

[timhieu02]

Nếu bạn chạy macro xong tất cả thì mình chỉ cần kiểm tra phần đầu (từng tiêu đề).Cái nào không đúng thì replace.

 

[huuthang_bd]

Nếu bạn chạy macro xong tất cả thì mình chỉ cần kiểm tra phần đầu (từng tiêu đề).Cái nào không đúng thì replace.

Vậy bạn hãy thử với Macro này:

Sub EditHeader()
Application.ScreenUpdating = False
Dim FirstCllAdd As String, FirstCll As Range, LastCll As Range, ACll As Range, Check As Boolean, Str As String
Set ACll = [A1]
FirstCllAdd = Cells.Find("~*------------------", ACll, xlFormulas, xlPart, xlByRows, xlNext).Address
Do
    Set FirstCll = Cells.FindNext(After:=ACll)
    Set ACll = FirstCll
    Set LastCll = FirstCll
    Str = ""
    If FirstCll.Address = FirstCllAdd Then Check = Not Check
    Do
        Str = Str & LastCll.Offset(-1).Value
        If LastCll.Value = "-------------------*" Or InStr(LastCll.Value, "------------------") = 0 Then Exit Do
        Set LastCll = LastCll.Offset(, 1)
    Loop
    With Range(FirstCll, LastCll).Offset(-1)
        .ClearContents
        .HorizontalAlignment = 7
    End With
    FirstCll.Offset(-1).Value = Str
Loop Until Not Check And FirstCll.Address = FirstCllAdd
Application.ScreenUpdating = True
End Sub

 

[timhieu02]

Thanks macro rất hay còn 1 vấn đề nhỏ thôi.Mình có thể merge các ô của từng tiêu đề lại với nhau được không?macro chạy ra tiêu đề vẫn nằm ở ô đầu tiên.

 

[huuthang_bd]

Thanks macro rất hay còn 1 vấn đề nhỏ thôi.Mình có thể merge các ô của từng tiêu đề lại với nhau được không?macro chạy ra tiêu đề vẫn nằm ở ô đầu tiên.

Dù có Merge lại thì dữ liệu vẫn nằm ở ô đầu tiên thôi. Lúc đầu tôi đã cố ý định dạng kiểu Center Across Selection thay vì Merge. Hiệu ứng của hai cái này là như nhau nhưng Merge sẽ gây ra một số khó khăn khi xử lý dữ liệu.
Nếu muốn Merge thì bạn sửa lại theo code này.

Sub EditHeader()
Application.ScreenUpdating = False
Dim FirstCllAdd As String, FirstCll As Range, LastCll As Range, ACll As Range, Check As Boolean, Str As String
Set ACll = [A1]
FirstCllAdd = Cells.Find("~*------------------", ACll, xlFormulas, xlPart, xlByRows, xlNext).Address
Do
    Set FirstCll = Cells.FindNext(After:=ACll)
    Set ACll = FirstCll
    Set LastCll = FirstCll
    Str = ""
    If FirstCll.Address = FirstCllAdd Then Check = Not Check
    Do
        Str = Str & LastCll.Offset(-1).Value
        If LastCll.Value = "-------------------*" Or InStr(LastCll.Value, "------------------") = 0 Then Exit Do
        Set LastCll = LastCll.Offset(, 1)
    Loop
    With Range(FirstCll, LastCll).Offset(-1)
        .ClearContents
        .Merge
        .HorizontalAlignment = xlCenter
    End With
    FirstCll.Offset(-1).Value = Str
Loop Until Not Check And FirstCll.Address = FirstCllAdd
Application.ScreenUpdating = True
End Sub

 

[timhieu02]

Không biết nói gì hơn nữa.Bạn quá giỏi,có thể cho mình xin số dtdd để sau này còn nhờ vã nữa,hjhj.

 

[huuthang_bd]

Không biết nói gì hơn nữa.Bạn quá giỏi,có thể cho mình xin số dtdd để sau này còn nhờ vã nữa,hjhj.

Xin lỗi, tôi không cho bạn số điện thoại được.

 

[timhieu02]

Vậy bạn có thể cho mình mail để liên lạc với bạn được không.Mình không làm phiền hay có ý xấu gì đâu.

 

[huuthang_bd]

Vậy bạn có thể cho mình mail để liên lạc với bạn được không.Mình không làm phiền hay có ý xấu gì đâu.

Email: nguyenhuuthang86@gmail.com
Tôi nghĩ nếu bạn có thắc mắc thì gửi lên đàn sẽ sớm có câu trả lời hơn là gửi mail riêng cho tôi.

 

[timhieu02]

merge cell

Mình gặp phải 1 vấn đề khi chạy macro (lỗi 91).

mình gửi attach file bạn sữa lại code dùm.macro báo lỗi:

Sub EditHeader()
Application.ScreenUpdating = False
Dim FirstCllAdd As String, FirstCll As Range, LastCll As Range, ACll As Range, Check As Boolean, Str As String
Set ACll = [A1]
FirstCllAdd = Cells.Find("~*------------------", ACll, xlFormulas, xlPart, xlByRows, xlNext).Address
Do
Set FirstCll = Cells.FindNext(After:=ACll)
Set ACll = FirstCll
Set LastCll = FirstCll
Str = ""
If FirstCll.Address = FirstCllAdd Then Check = Not Check
Do
Str = Str & LastCll.Offset(-1).Value
If LastCll.Value = "-------------------*" Or InStr(LastCll.Value, "------------------") = 0 Then Exit Do
Set LastCll = LastCll.Offset(, 1)
Loop
With Range(FirstCll, LastCll).Offset(-1)
.ClearContents
.Merge
.HorizontalAlignment = xlCenter
End With
FirstCll.Offset(-1).Value = Str
Loop Until Not Check And FirstCll.Address = FirstCllAdd
Application.ScreenUpdating = True
End Sub
file mình chạy macro:

	City		Gen	der
*-------------	---------------	--------------*	*-------------	--------------*
HCMC	Ha Noi	Da Nang	Male	Female

mình nghĩ nó bị lỗi chỗ City.