Mình có file excel mong GPE giúp đỡ về ghép dòng:
- Dữ liệu ở sheet1: ghép 2 dòng với nhau: sao cho từ cột thứ 4 đến cột thứ 6, Từ cột thứ 7 đến cột thứ 9, từ cột 10 đến cột 12,.... trong nhóm cột đó đều chứa dữ liệu. Kết quả suất sang sheet2.
- Tương tự như vậy:
ghép 3 dòng với nhau: sao cho từ cột thứ 4 đến cột thứ 6, Từ cột thứ 7 đến cột thứ 9, từ cột 10 đến cột 12,.... trong nhóm cột đó đều chứa dữ liệu. Kết quả suất sang sheet3.
- Mình làm file minh hoạ như trên ạ! Mong GPE giúp đỡ! Xin chân thành cảm ơn!
Tặng bạn vài "củ chuối" xài tạm:
1. Ghép 2 dòng:
[GPECODE=vb]Sub Ghep2Dong()
Dim i As Long, j As Long, k As Long, n As Long, m As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
n = Sheet1.[A65000].End(xlUp).Row
m = Sheet1.UsedRange.Columns.Count
Sheet2.Cells.Clear
For i = 5 To n - 1
For j = i + 1 To n
For k = 4 To m Step 3
If WorksheetFunction.Count(Union(Sheet1.Cells(i, k).Resize(, 3), Sheet1.Cells(j, k).Resize(, 3))) = 0 Then Exit For
Next
If k > m Then
Sheet1.Cells(i, 1).Resize(, m).Copy Sheet2.[A65000].End(xlUp).Offset(2)
Sheet1.Cells(j, 1).Resize(, m).Copy Sheet2.[A65000].End(xlUp).Offset(1)
End If
Next
Next
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub[/GPECODE]
2. Ghép 3 dòng:
[GPECODE=vb]Sub Ghep3Dong()
Dim i As Long, j As Long, k As Long, l As Long, n As Long, m As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
n = Sheet1.[A65000].End(xlUp).Row
m = Sheet1.UsedRange.Columns.Count
Sheet3.Cells.Clear
For i = 5 To n - 2
For j = i + 1 To n - 1
For k = j + 1 To n
For l = 4 To m Step 3
If WorksheetFunction.Count(Union(Sheet1.Cells(i, l).Resize(, 3), Sheet1.Cells(j, l).Resize(, 3), Sheet1.Cells(k, l).Resize(, 3))) = 0 Then Exit For
Next
If l > m Then
Sheet1.Cells(i, 1).Resize(, m).Copy Sheet3.[A65000].End(xlUp).Offset(2)
Sheet1.Cells(j, 1).Resize(, m).Copy Sheet3.[A65000].End(xlUp).Offset(1)
Sheet1.Cells(k, 1).Resize(, m).Copy Sheet3.[A65000].End(xlUp).Offset(1)
End If
Next
Next
Next
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub[/GPECODE]