Nhờ giúp đoạn code ghép dòng theo điều kiện

Liên hệ QC
S

sep_hatxel

Thành viên thường trực
Tham gia
24/5/10
Bài viết
217
Được thích
7
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!
 

File đính kèm

  • GHEPDONG.xlsx
    19.5 KB · Đọc: 24
- Mình có 1 file tìm ghép 2 dòng mà cứ trong 2 cột lần lượt: từ cột 2->3, từ cột 4->5, từ cột 6->7,... có chứa dữ liệu là thoả mãn.
- Trong bài #1 muốn tìm ghép 2 dòng mà cứ trong 3 cột lần lượt từ cột 2->4, từ cột 5->7, từ cột 8->10,... có chứa dữ liệu là thoả mãn thì làm thế nào ạ?
- Rất mong GPE xem giúp! Xin chân thành cảm ơn!
 

File đính kèm

  • GHEPDONG_2COT.xls
    105.5 KB · Đọc: 11
sep_hatxel đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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]
 

File đính kèm

  • GHEPDONG.xlsm
    21 KB · Đọc: 6
nghiaphuc đã viết:
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]
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn Nghĩa Phúc và GPE rất nhiều! Mình rất thích cách làm này của bạn Nghĩa Phúc, nếu chỉ muốn tìm 1 dòng thôi ở dữ liệu sheet1: 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 thì cần sửa code đoạn nào ạ? Xin cảm ơn rất nhiều!
 
sep_hatxel đã viết:
Cảm ơn bạn Nghĩa Phúc và GPE rất nhiều! Mình rất thích cách làm này của bạn Nghĩa Phúc, nếu chỉ muốn tìm 1 dòng thôi ở dữ liệu sheet1: 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 thì cần sửa code đoạn nào ạ? Xin cảm ơn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Vậy thì sửa lại thế này:
[GPECODE=vb]Sub Tim1Dong()
Dim i 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
For k = 4 To m Step 3
If WorksheetFunction.Count(Sheet1.Cells(i, 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)
Next
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub[/GPECODE]
Nếu bạn muốn các dòng kết quả ở sheet 2 nằm liền nhau thì sửa số 2 ở cuối dòng lệnh thứ 13 thành số 1.
 
nghiaphuc đã viết:
Vậy thì sửa lại thế này:
[GPECODE=vb]Sub Tim1Dong()
Dim i 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
For k = 4 To m Step 3
If WorksheetFunction.Count(Sheet1.Cells(i, 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)
Next
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub[/GPECODE]
Nếu bạn muốn các dòng kết quả ở sheet 2 nằm liền nhau thì sửa số 2 ở cuối dòng lệnh thứ 13 thành số 1.
Nhấp chuột vào đây để mở rộng...
Bạn ơi, nếu dữ liệu ở sheet1 bắt đầu từ cột G nhưng kết quả xuất sang sheet2 lại dán vào từ cột A như file minh hoạ thì làm thế nào bạn? Mong giúp đỡ ạ! Xin cảm ơn rất nhiều!
 

File đính kèm

  • GHEPDONG.xlsm
    25.5 KB · Đọc: 7
sep_hatxel đã viết:
Bạn ơi, nếu dữ liệu ở sheet1 bắt đầu từ cột G nhưng kết quả xuất sang sheet2 lại dán vào từ cột A như file minh hoạ thì làm thế nào bạn? Mong giúp đỡ ạ! Xin cảm ơn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Code sẽ được sửa lại thế này:
Mã: 
Sub Tim1Dong()
    Dim i As Long, k As Long, n As Long, m As Long
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual
    End With
    n = Sheet1.[[COLOR=#ff0000]G[/COLOR]65000].End(xlUp).Row
    m = Sheet1.UsedRange.Columns.Count [COLOR=#ff0000]+ 6[/COLOR]
    Sheet2.Cells.Clear
    For i = 5 To n
        For k = [COLOR=#ff0000]10[/COLOR] To m Step 3
            If WorksheetFunction.Count(Sheet1.Cells(i, k).Resize(, 3)) = 0 Then Exit For
        Next
        If k > m Then Sheet1.Cells(i, [COLOR=#ff0000]7[/COLOR]).Resize(, m).Copy Sheet2.[A65000].End(xlUp).Offset(2)
    Next
    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
    End With
End Sub
Những vị trí màu đỏ là những vị trí thay đổi so với code ở bài trên.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

hongquan93vn
Giữ được Hide dòng khi dùng "clear" trong phần học
Trả lời
4
Đọc
81
ngocmaipretty
ngocmaipretty
K
Set macro là disable nhưng file macro vẫn chạy !
Trả lời
3
Đọc
48
kietbui
K
C
  • Question
Tạo schedule chạy code VBA
Trả lời
5
Đọc
206
castanea
C
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
25
Đọc
435
Hoàng Tuấn 868
H
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
10
Đọc
265
phammaihuong90
phammaihuong90
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom