+ Ghép 2 dòng với nhau lần lượt từ trên xuống dưới bắt đầu từ dòng 4 đến hết (Dòng 4 ghép hết với các dòng còn lại thì lại tiếp tục chuyển sang đến dòng 5 ghép với các dòng còn lại,.v.v.. cứ như vậy)
Vâng! Cụ thể như sau ạ:Câu như vầy lại đâm ra khó hiểu rồi:
& 1 vấn đề nữa fát sinh là: Dòng cuối cùng sẽ fải nối với hư vô chăng?
Sao giống bài này quá ta:Mấy ngày ăn tết thật vui vẻ thoải mái! Cảm ơn GPE nhiều quá!
GPE có thể xem giúp mình trường hợp ghép dòng có điều kiện như thế này thì làm như thế nào ạ? Mình có gửi kèm theo file excel2007!
- Mong tin vui! Thân ái!
Cảm ơn bạn SA_DQ!Mình vừa dùng hàm tự tạo để tính các ô liên tiếp có dữ liệu thì cao nhứt là 11 ô, còn lại là 7 hay 8 ô;
Những ô có xác suất cao được chọn này cũng không có cặp đôi nào thoả được điều kiện của bạn đề ra là liên tiếp 15 ô có dữ liệu.
Cũng như ở đây: http://www.giaiphapexcel.com/forum/showthread.php?45222-Lọc-với-rất-nhiều-điều-kiện Chúng tôi cũng đã fải giả lập, thêm & bớt dữ liệu để kiểm chứng tính đúng đắn của chương trính.
Lần sau bạn nên rút kinh nghiệm về chuyện này!
Còn bây giờ thì . . . . mạnh ai nấy sửa vậy!
Mình mở file E2003 & thấy như vầy:- File mình gửi kèm theo có trường hợp thoả mãn đó là:
+ Trường hợp ghép 2 dòng: có dòng 4 (1;2) và dòng 5 (1;3) khi ghép với nhau là thoả mãn có hẳn 20 cột liên tiếp có dữ liệu!
Vâng! Bạn àh! Bạn xem hộ mình điều kiện là ghép dòng sao cho bắt đầu đếm từ cột B liên tiếp ít nhất 15 cột có chứa dữ liệu là thoả mãn (Trong cùng một cột chỉ cần có dữ liệu ở 1 trong 2 dòng là được)!Mình mở file E2003 & thấy như vầy:
Dòng 4 từ cột K đến cột U có dữ liệu & max trong dòng; Dòng 5 từ cột c->J có dữ liệu & MAX trong nớ.
Mình ghép nối đuôi nhau thì Số ô liên tiếp lớn nhứt có dữ liệu vẫn là 11 tròn trĩnh mà thôi! (Đừng có nói với tôi là bạn cộng dồn đó nhe!)
Đang còn chậm lắm & E2003 đó nghe!
Option Explicit
Sub Gop3Dong()
Dim Rng As Range, Sh As Worksheet
Dim jJ As Long, Jw As Long, jZ As Long, Col As Byte, Rws As Long, Cot As Byte
Dim Timer_ As Double: Dim MyAdd As String
Sheet1.Select: Timer_ = Timer
Set Rng = [b1].CurrentRegion: Col = Rng.Columns.Count
Rws = [A65500].End(xlUp).Row
Cells(4, Col + 2).Resize(Rws, Col).Clear: Sheet2.[a1].Resize(5 * Rws, Col).Clear
Set Sh = ThisWorkbook.Worksheets("S3")
For jJ = 4 To Rws - 2
For Jw = jJ + 1 To Rws - 1
For jZ = Jw + 1 To Rws
Sh.[b1].Resize(, Col).Clear
Sh.[b1].Resize(, Col).Value = Cells(jJ, "B").Resize(, Col).Value
Set Rng = Cells(Jw, "B").Resize(, Col)
For Cot = 2 To Col
If Cells(Jw, Cot).Value <> "" Or Cells(jZ, Cot).Value <> "" Then
Sh.Cells(1, Cot).Value = IIf(Cells(Jw, Cot).Value <> "", 8, 9)
End If
Next Cot
If Sh.[Ba1] > 24 Then
With Sheet2.[A65500].End(xlUp).Offset(2)
.Resize(, Col).Value = Cells(jJ, "A").Resize(, Col).Value
.Offset(1).Resize(, Col).Value = Cells(Jw, "A").Resize(, Col).Value
.Offset(2).Resize(, Col).Value = Cells(jZ, "A").Resize(, Col).Value
End With
End If
Next jZ
Next Jw
Sheet2.[a1].Value = Timer() - Timer_
If Timer() - Timer_ > 60 Then Exit For
Next jJ
Sheet2.Select
End Sub
- Hix! Bác Chanh TQ ơi! Mình cho chạy code mà sao không được kết quả? Mình không hiểu sai ở đâu lắm?PHP:Option Explicit Sub Gop3Dong() Dim Rng As Range, Sh As Worksheet Dim jJ As Long, Jw As Long, jZ As Long, Col As Byte, Rws As Long, Cot As Byte Dim Timer_ As Double: Dim MyAdd As String Sheet1.Select: Timer_ = Timer Set Rng = [b1].CurrentRegion: Col = Rng.Columns.Count Rws = [A65500].End(xlUp).Row Cells(4, Col + 2).Resize(Rws, Col).Clear: Sheet2.[a1].Resize(5 * Rws, Col).Clear Set Sh = ThisWorkbook.Worksheets("S3") For jJ = 4 To Rws - 2 For Jw = jJ + 1 To Rws - 1 For jZ = Jw + 1 To Rws Sh.[b1].Resize(, Col).Clear Sh.[b1].Resize(, Col).Value = Cells(jJ, "B").Resize(, Col).Value Set Rng = Cells(Jw, "B").Resize(, Col) For Cot = 2 To Col If Cells(Jw, Cot).Value <> "" Or Cells(jZ, Cot).Value <> "" Then Sh.Cells(1, Cot).Value = IIf(Cells(Jw, Cot).Value <> "", 8, 9) End If Next Cot If Sh.[Ba1] > 24 Then With Sheet2.[A65500].End(xlUp).Offset(2) .Resize(, Col).Value = Cells(jJ, "A").Resize(, Col).Value .Offset(1).Resize(, Col).Value = Cells(Jw, "A").Resize(, Col).Value .Offset(2).Resize(, Col).Value = Cells(jZ, "A").Resize(, Col).Value End With End If Next jZ Next Jw Sheet2.[a1].Value = Timer() - Timer_ If Timer() - Timer_ > 60 Then Exit For Next jJ Sheet2.Select End Sub
Nếu muốn cho nhiều kết quả hơn thì tăng thời gian chạy lên thay vì 60''.
![]()
![]()
![]()
![]()
![]()
![]()
. . . . . .
Bọn mình vẫn chép lên Sheet2 Vì Sheet3 đã bị trưng thu làm trang nền kết quả rồi, hi, hi,. . . .Điều kiện chính xác ở đây là tìm ghép dòng sao cho:
+ Trường hợp ghép 2 dòng: ít nhất 15 cột đầu tiên liên tiếp bắt đầu tính từ cột B có dữ liệu là thoả mãn chép sang sheet 2
+ Trường hợp ghép 3 dòng: ít nhất 25 cột đầu tiên liên tiếp bắt đầu tính từ cột B có dữ liệu là thoả mãn chép sang sheet3
Bọn mình vẫn chép lên Sheet2 Vì Sheet3 đã bị trưng thu làm trang nền kết quả rồi, hi, hi,. . . .
Option Explicit
Sub First25ColumnsNoneBlank()
Dim jJ As Long, Ww As Long, zZ As Long, Col As Byte, Ff As Byte
Dim Rws As Long, Timer_ As Double: Const H5 As Byte = 26
Dim jRng As Range, wRng As Range, zRng As Range, sRng As Range
Sheet1.Select: Timer_ = Timer
Rws = [A65500].End(xlUp).Row: Col = H5 + 2
Sheet4.[a1].Resize(5 * Rws, 5 + H5).Clear
For jJ = 4 To Rws - 2
Set jRng = Cells(jJ, "B").Resize(, H5)
For Ww = jJ + 1 To Rws - 1
Set wRng = Cells(Ww, "B").Resize(, H5)
For zZ = Ww + 1 To Rws
Set zRng = Cells(zZ, "B").Resize(, H5)
For Ff = 2 To H5
Set sRng = Union(Cells(jJ, Ff), Cells(Ww, Ff), Cells(zZ, Ff))
If Application.WorksheetFunction.Sum(sRng) < 1 Then
Exit For
End If
Next Ff
If Ff >= H5 Then
With Sheet4.[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
.Offset(2).Resize(, Col).Value = Cells(zZ, "A").Resize(, Col).Value
If Ff = H5 Then
.Offset(, H5 - 1).Resize(3, 3).Interior.ColorIndex = 39
End If
End With
End If
Next zZ
Next Ww
Next jJ
Sheet4.[a1].Value = Timer() - Timer_: Sheet4.Select
End Sub
PHP:Option Explicit Sub First25ColumnsNoneBlank() Dim jJ As Long, Ww As Long, zZ As Long, Col As Byte, Ff As Byte Dim Rws As Long, Timer_ As Double: Const H5 As Byte = 26 Dim jRng As Range, wRng As Range, zRng As Range, sRng As Range Sheet1.Select: Timer_ = Timer Rws = [A65500].End(xlUp).Row: Col = H5 + 2 Sheet4.[a1].Resize(5 * Rws, 5 + H5).Clear For jJ = 4 To Rws - 2 Set jRng = Cells(jJ, "B").Resize(, H5) For Ww = jJ + 1 To Rws - 1 Set wRng = Cells(Ww, "B").Resize(, H5) For zZ = Ww + 1 To Rws Set zRng = Cells(zZ, "B").Resize(, H5) For Ff = 2 To H5 Set sRng = Union(Cells(jJ, Ff), Cells(Ww, Ff), Cells(zZ, Ff)) If Application.WorksheetFunction.Sum(sRng) < 1 Then Exit For End If Next Ff If Ff >= H5 Then With Sheet4.[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 .Offset(2).Resize(, Col).Value = Cells(zZ, "A").Resize(, Col).Value If Ff = H5 Then .Offset(, H5 - 1).Resize(3, 3).Interior.ColorIndex = 39 End If End With End If Next zZ Next Ww Next jJ Sheet4.[a1].Value = Timer() - Timer_: Sheet4.Select End Sub
[COLOR=#000000][COLOR=#007700][/COLOR][COLOR=#0000BB]Col [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]H5 [/COLOR][COLOR=#007700]+ [/COLOR][COLOR=#0000BB]2
Col = [iV1].end(xlToLeft).column
Ta sửa lại fần dòng lệnh
Mã:[COLOR=#000000][COLOR=#007700][/COLOR][COLOR=#0000BB]Col [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]H5 [/COLOR][COLOR=#007700]+ [/COLOR][COLOR=#0000BB]2
bằng dòng lệnhPHP:Col = [iV1].end(xlToLeft).column
Nếu bạn chép hay gỏ dòng lệnh này & sau khi cho con trỏ đến dòng lệnh khác mà chữ 'c' nó trổ bông để nghênh đoán tân xuân là OK đó nha!
[/COLOR][/COLOR]