Ghép dòng

[SA_DQ]

Tất nhiên là được mà bạn:

Option Explicit
Sub First15ColumnIn2RowsHasValues()
 Dim jJ As Long, Ww As Long, Col As Byte, Ff As Byte
 Dim Rws As Long, Timer_ As Double:                     Const H7 As Byte = 15
 Dim jRng As Range, wRng As Range, sRng As Range

 Sheet1.Select:                                         Timer_ = Timer
 Rws = [A65500].End(xlUp).Row:                          Col = [Iv2].End(xlToLeft).Column
 Sheet2.[a1].Resize(3 * Rws, Col).Clear
 For jJ = 4 To Rws - 1
    Set jRng = Cells(jJ, "B").Resize(, H7)
    For Ww = jJ + 1 To Rws
        Set wRng = Cells(Ww, "B").Resize(, H7)
        For Ff = 2 To H7
            Set sRng = Union(Cells(jJ, Ff), Cells(Ww, Ff))
            If Application.WorksheetFunction.Sum(sRng) < 1 Then
                Exit For
            End If
        Next Ff
        If Ff >= H7 Then
            With Sheet2.[A65500].End(xlUp).Offset(2)
                .Resize(, Col).Value = Cells(jJ, "A").Resize(, Col).Value
                .Offset(1).Resize(, Col).Value = Cells(Ww, "A").Resize(, Col).Value
                If Ff > H7 Then _
                    .Offset(, H7 - 14).Resize(2, Ff).Font.ColorIndex = 3
            End With
        End If
    Next Ww
 Next jJ
 Sheet2.[a1].Value = Timer() - Timer_:                  Sheet2.Select
End Sub

 

[hcl_pt]

Option Explicit
Sub First15ColumnIn2RowsHasValues()
Dim jJ As Long, Ww As Long, Col As Byte, Ff As Byte
Dim Rws As Long, Timer_ As Double: Const H7 As Byte = 15
Dim jRng As Range, wRng As Range, sRng As Range
 
Sheet1.Select: Timer_ = Timer
Rws = [A65500].End(xlUp).Row: Col = [Iv2].End(xlToLeft).Column
Sheet2.[a1].Resize(3 * Rws, Col).Clear
For jJ = 4 To Rws - 1
Set jRng = Cells(jJ, "B").Resize(, H7)
For Ww = jJ + 1 To Rws
Set wRng = Cells(Ww, "B").Resize(, H7)
For Ff = 2 To H7
Set sRng = Union(Cells(jJ, Ff), Cells(Ww, Ff))
If Application.WorksheetFunction.Sum(sRng) < 1 Then
Exit For
End If
Next Ff
If Ff >= H7 Then
With Sheet2.[A65500].End(xlUp).Offset(2)
.Resize(, Col).Value = Cells(jJ, "A").Resize(, Col).Value
.Offset(1).Resize(, Col).Value = Cells(Ww, "A").Resize(, Col).Value
If Ff > H7 Then _
.Offset(, H7 - 14).Resize(2, Ff).Font.ColorIndex = 3
End With
End If
Next Ww
Next jJ
Sheet2.[a1].Value = Timer() - Timer_: Sheet2.Select
End Sub

- Chào buổi sáng! Chào GPE!
Bạn HYen ơi! Với đoạn code này mình test thì vẫn có trường hợp 13 cột đầu tiên có dữ liệu vẫn chép sang sheet2?
- Chân thành mong bạn chỉ điểm cho mình cách sửa đoạn code trên mình nên sửa ở những dòng code nào nếu mình muốn điều kiện là 20 cột đầu tiên, hay 25 cột đầu tiên,... có dữ liệu chép sang sheet2? Nếu mình hiểu cách sửa thì mình sẽ dễ dàng tuỳ biến điều kiện!
- Chúc bạn một ngày làm việc thành công! Cảm ơn bạn! Thân ái!

 

[ChanhTQ@]

Bạn thấy fần sau của dòng lệnh

[COLOR=#000000][COLOR=#007700]Const [/COLOR][COLOR=#0000BB]H7 [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Byte [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]15

này chứ?, Nó đó bạn & hãy thử thay bằng các con số nào lớn hơn 2 xem sao?


[/COLOR][/COLOR]