Lọc dữ liệu và sắp xếp sang sheet khác theo điều kiện

Liên hệ QC
S

sonvt_vnpt

Thành viên mới
Tham gia
19/2/10
Bài viết
34
Được thích
1
Mình có file excel đính kèm kính nhờ các anh chị trên diễn đàn bớt chút thời gian giúp về việc lọc dữ liệu từ sheet S1 sang sheet S2 theo điều kiện. Cụ thể như sau:
1.Lọc dữ liệu từ sheet S1 sang sheet S2 với điều kiện cột H sheet S1 = "Chưa có ĐK"
2.sắp xếp dữ liệu đã lọc từ sheet S1 với điều kiện trên sang sheet S2 vào các cột tương ứng(Cột A của S1 vào cột C của S2; Cột B của S1 vào cột C của S2; Cột C của S1 vào cột E của S2; Cột D của S1 vào cột F của S2; cột G của S1 vào cột K của S2; Cột I của S1 vào cột L của S2...)
3.Đồng thời tại cột F của S1, nếu là điểm a Khoản 1 thì đánh dấu X vào cột H của S2, điểm b thì đánh dấu X vào cột I, điểm c thì đánh dấu X vào cột j).
Kính nhờ các anh chị trên diễn đàn giúp ! Trân trọng cám ơn !
 
sonvt_vnpt đã viết:
Mình có file excel đính kèm kính nhờ các anh chị trên diễn đàn bớt chút thời gian giúp về việc lọc dữ liệu từ sheet S1 sang sheet S2 theo điều kiện. Cụ thể như sau:
1.Lọc dữ liệu từ sheet S1 sang sheet S2 với điều kiện cột H sheet S1 = "Chưa có ĐK"
2.sắp xếp dữ liệu đã lọc từ sheet S1 với điều kiện trên sang sheet S2 vào các cột tương ứng(Cột A của S1 vào cột C của S2; Cột B của S1 vào cột C của S2; Cột C của S1 vào cột E của S2; Cột D của S1 vào cột F của S2; cột G của S1 vào cột K của S2; Cột I của S1 vào cột L của S2...)
3.Đồng thời tại cột F của S1, nếu là điểm a Khoản 1 thì đánh dấu X vào cột H của S2, điểm b thì đánh dấu X vào cột I, điểm c thì đánh dấu X vào cột j).
Kính nhờ các anh chị trên diễn đàn giúp ! Trân trọng cám ơn !
Nhấp chuột vào đây để mở rộng...
Cột 1,2,7 của S2 bạn định ghi gì vào đó?
 
Hai Lúa Miền Tây đã viết:
Cột 1,2,7 của S2 bạn định ghi gì vào đó?
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn đã xem qua file của mình gửi lên. Do sơ suất nên mình viết nhầm và thiếu. Cột 1 bên S2 là số thứ tự, cột 2 bên S2 để trống, cột 7 bên S2 chính là dữ liệu của cột E (loại nghĩa vụ) bên S1. Nếu có thời gian mong bạn giúp ! Trân trọng cám ơn bạn !
 
sonvt_vnpt đã viết:
Mình có file excel đính kèm kính nhờ các anh chị trên diễn đàn bớt chút thời gian giúp về việc lọc dữ liệu từ sheet S1 sang sheet S2 theo điều kiện. Cụ thể như sau:
1.Lọc dữ liệu từ sheet S1 sang sheet S2 với điều kiện cột H sheet S1 = "Chưa có ĐK"
2.sắp xếp dữ liệu đã lọc từ sheet S1 với điều kiện trên sang sheet S2 vào các cột tương ứng(Cột A của S1 vào cột C của S2; Cột B của S1 vào cột C của S2; Cột C của S1 vào cột E của S2; Cột D của S1 vào cột F của S2; cột G của S1 vào cột K của S2; Cột I của S1 vào cột L của S2...)
3.Đồng thời tại cột F của S1, nếu là điểm a Khoản 1 thì đánh dấu X vào cột H của S2, điểm b thì đánh dấu X vào cột I, điểm c thì đánh dấu X vào cột j).
Kính nhờ các anh chị trên diễn đàn giúp ! Trân trọng cám ơn !
Nhấp chuột vào đây để mở rộng...

Bạn chạy thử sub này nhé.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, DK As String
DK = "CH*K"
With Sheets("S1")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 10).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 12)
For I = 1 To UBound(sArr)
    If UCase(sArr(I, 8)) Like DK Then
        K = K + 1: dArr(K, 1) = K
        For J = 1 To 5
            dArr(K, J + 2) = sArr(I, J)
        Next J
        If Mid(sArr(I, 6), 6, 1) = "a" Then
            dArr(K, 8) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "b" Then
            dArr(K, 9) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "c" Then
            dArr(K, 10) = "x"
        End If
        If sArr(I, 7) > 0 Then dArr(K, 11) = sArr(I, 7)
        dArr(K, 12) = sArr(I, 9)
    End If
Next I
With Sheets("S2")
    .Range("A12").Resize(1000, 12).ClearContents
    .Range("A12").Resize(K, 12) = dArr
End With
End Sub
Chờ HLMT xuất chiêu ADO độc cho bạn.
 
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Bạn chạy thử sub này nhé.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, DK As String
DK = "CH*K"
With Sheets("S1")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 10).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 12)
For I = 1 To UBound(sArr)
    If UCase(sArr(I, 8)) Like DK Then
        K = K + 1: dArr(K, 1) = K
        For J = 1 To 5
            dArr(K, J + 2) = sArr(I, J)
        Next J
        If Mid(sArr(I, 6), 6, 1) = "a" Then
            dArr(K, 8) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "b" Then
            dArr(K, 9) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "c" Then
            dArr(K, 10) = "x"
        End If
        If sArr(I, 7) > 0 Then dArr(K, 11) = sArr(I, 7)
        dArr(K, 12) = sArr(I, 9)
    End If
Next I
With Sheets("S2")
    .Range("A12").Resize(1000, 12).ClearContents
    .Range("A12").Resize(K, 12) = dArr
End With
End Sub
Chờ HLMT xuất chiêu ADO độc cho bạn.
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn nhiều nhé ! mình đã test thử code trên của bạn, chạy OK nhưng mình muốn làm việc này bằng các hàm dò tìm nào đó có được không bạn??
 
sonvt_vnpt đã viết:
Cám ơn bạn đã xem qua file của mình gửi lên. Do sơ suất nên mình viết nhầm và thiếu. Cột 1 bên S2 là số thứ tự, cột 2 bên S2 để trống, cột 7 bên S2 chính là dữ liệu của cột E (loại nghĩa vụ) bên S1. Nếu có thời gian mong bạn giúp ! Trân trọng cám ơn bạn !
Nhấp chuột vào đây để mở rộng...
BẠn muốn dùng hàm thì nhờ các bạn khác giúp.
Tôi lỡ viết ADO rồi:

[GPECODE=sql]Sub LayDuLieu_HaiLua()

Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
Set rs = cn.Execute("SELECT F1,F2,F3,F4,F5,IIF(F6='" & Sheet2.[B2] & "','X',''),IIF(F6='" & Sheet2.[B3] & "','X',''),IIF(F6='" & Sheet2.[B4] & "','X',''),F7,F9 FROM [S1$A2:I100] where F8='" & Sheet2.[D2] & "'")
With Sheets("S2")
.[A12:M100].ClearContents
.[C12].CopyFromRecordset rs
.Range("A12:A" & .Range("C65000").End(3).Row).FormulaR1C1 = "=ROW()-11"
End With

End Sub


[/GPECODE]
 
Nếu không cần sheet phụ cho bạn dễ thay đổi thì bạn chạy code sau:

[GPECODE=sql]Sub LayDuLieu_HaiLua()

Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
Set rs = cn.Execute("SELECT F1,F2,F3,F4,F5,IIF(F6 like '%a%','X',''),IIF(F6 like '%b%','X',''),IIF(F6 like '%c%','X',''),F7,F9 FROM [S1$A2:I100] where F8 like 'Ch%K%'")
With Sheets("S2")
.[A12:M100].ClearContents
.[C12].CopyFromRecordset rs
.Range("A12:A" & .Range("C65000").End(3).Row).FormulaR1C1 = "=ROW()-11"
End With

End Sub[/GPECODE]
 
sonvt_vnpt đã viết:
Cám ơn bạn nhiều nhé ! mình đã test thử code trên của bạn, chạy OK nhưng mình muốn làm việc này bằng các hàm dò tìm nào đó có được không bạn??
Nhấp chuột vào đây để mở rộng...
Bạn ơi ! Mình có thêm 1 file cần lấy dữ liệu tương tự như file bạn đã giúp mình như code này. Mình muốn lấy dữ liệu bằng cách tương tự bạn dùng code này giúp mình với file trước. Bạn làm ơn giúp mình với file đính kèm này với. Cám ơn bạn !
Với file này : điều kiện lấy dữ liệu từ sheet loctdnh sang sheet án tdnh-kdtm là : cột M; cột N của sheet loctdnh thỏa mãn đồng thời M= Theo đơn; N = KD thương mại. Dữ liệu lấy sang sheet Án tdnh-kdtm là các cột tương ứng.
Mong bạn bớt chút thời gian giúp đỡ ! (Các cột J;K;L bên sheet Án tdnh-kdtm để trống)
 
Ba Tê đã viết:
Bạn chạy thử sub này nhé.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, DK As String
DK = "CH*K"
With Sheets("S1")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 10).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 12)
For I = 1 To UBound(sArr)
    If UCase(sArr(I, 8)) Like DK Then
        K = K + 1: dArr(K, 1) = K
        For J = 1 To 5
            dArr(K, J + 2) = sArr(I, J)
        Next J
        If Mid(sArr(I, 6), 6, 1) = "a" Then
            dArr(K, 8) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "b" Then
            dArr(K, 9) = "x"
        ElseIf Mid(sArr(I, 6), 6, 1) = "c" Then
            dArr(K, 10) = "x"
        End If
        If sArr(I, 7) > 0 Then dArr(K, 11) = sArr(I, 7)
        dArr(K, 12) = sArr(I, 9)
    End If
Next I
With Sheets("S2")
    .Range("A12").Resize(1000, 12).ClearContents
    .Range("A12").Resize(K, 12) = dArr
End With
End Sub
Chờ HLMT xuất chiêu ADO độc cho bạn.
Nhấp chuột vào đây để mở rộng...
Bạn làm ơn đọc bài #10 xong giúp mình với nhé, mình post trích dẫn nhầm. ! Cám ơn bạn !
 
sonvt_vnpt đã viết:
Bạn ơi ! Mình có thêm 1 file cần lấy dữ liệu tương tự như file bạn đã giúp mình như code này. Mình muốn lấy dữ liệu bằng cách tương tự bạn dùng code này giúp mình với file trước. Bạn làm ơn giúp mình với file đính kèm này với. Cám ơn bạn !
Với file này : điều kiện lấy dữ liệu từ sheet loctdnh sang sheet án tdnh-kdtm là : cột M; cột N của sheet loctdnh thỏa mãn đồng thời M= Theo đơn; N = KD thương mại. Dữ liệu lấy sang sheet Án tdnh-kdtm là các cột tương ứng.
Mong bạn bớt chút thời gian giúp đỡ ! (Các cột J;K;L bên sheet Án tdnh-kdtm để trống)
Nhấp chuột vào đây để mở rộng...
Bạn xem lại chỗ tô màu đỏ nhé.
 
sonvt_vnpt đã viết:
Bạn ơi ! Mình có thêm 1 file cần lấy dữ liệu tương tự như file bạn đã giúp mình như code này. Mình muốn lấy dữ liệu bằng cách tương tự bạn dùng code này giúp mình với file trước. Bạn làm ơn giúp mình với file đính kèm này với. Cám ơn bạn !
Với file này : điều kiện lấy dữ liệu từ sheet loctdnh sang sheet án tdnh-kdtm là : cột M; cột N của sheet loctdnh thỏa mãn đồng thời M= Theo đơn; N = KD thương mại. Dữ liệu lấy sang sheet Án tdnh-kdtm là các cột tương ứng.
Mong bạn bớt chút thời gian giúp đỡ ! (Các cột J;K;L bên sheet Án tdnh-kdtm để trống)
Nhấp chuột vào đây để mở rộng...
Mình chế biến lại code của anh @HaiLua, bạn test code (bạn bị nhầm lẫn cột M với N nhé)
Mã: 
Sub LayDuLieu_HaiLua()
    Dim cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Set rs = cn.Execute("SELECT f1,f2,f3,f4,f5,f6,f7,f8 FROM [loctdnh$B6:N" & Sheets(1).Range("M65000").End(3).Row & "] where f12 like 'KD th%' and f13 like 'Theo%'")
    With Sheets(2)
        .[A6:N1000].ClearContents
        .[B6].CopyFromRecordset rs
        .Range("A6:A" & .Range("C65000").End(3).Row).FormulaR1C1 = "=ROW()-5"
    End With
End Sub
 
Code # cho bạn
Mã: 
Sub filter()
    Sheets(2).Range("A6:L100").ClearContents
    With Sheets(1)
        lr = .Range("M65000").End(3).Row
        .Range("$A$4:$N$" & lr).AutoFilter Field:=13, Criteria1:="KD th*", Operator:=xlAnd
        .Range("$A$4:$N$" & lr).AutoFilter Field:=14, Criteria1:="Theo *", Operator:=xlAnd
        .Range("B6:I" & lr).SpecialCells(2).Copy Sheets(2).Range("B6")
        .Range("$A$4:$N$" & lr).AutoFilter
    End With
    Sheets(2).Range("A6:A" & Sheets(2).Range("C65000").End(3).Row).FormulaR1C1 = "=ROW()-5"
End Sub
 
sonvt_vnpt đã viết:
Bạn làm ơn đọc bài #10 xong giúp mình với nhé, mình post trích dẫn nhầm. ! Cám ơn bạn !
Nhấp chuột vào đây để mở rộng...

Bạn có 2 điều kiện lọc?
Sao không làm 2 ô điều kiện. Muốn thay đổi điều kiện lọc cứ thay đổi trong 2 ô này rồi bấm nút?
 

File đính kèm

Xin chân thành cám ơn sự giúp đỡ chia sẻ của mọi người, nhờ mọi người nhờ có sự giúp đỡ của mọi người ở trên mình đã hoàn thành được file như mong muốn, qua đó học hỏi được thêm kiến thức về EXCEL. Cám ơn diễn đàn đã tạo điều kiện. Chúc mọi người sức khỏe, thành công trong cuộc sống ! Trân trọng cám ơn !
 
Bạn có 2 điều kiện lọc?
Sao không làm 2 ô điều kiện. Muốn thay đổi điều kiện lọc cứ thay đổi trong 2 ô này rồi bấm nút?

Mình thấy ý tưởng của Ba Tê rất hay khi có thêm các lựa chọn. Nhưng mình không hiểu i,j,k nếu thay đổi ít cột hơn thì phần này có thay đổi không bạn, Hướng dẫn giúp mình nhé. Cảm ơn nhiều
 
vncn1582 đã viết:
Bạn có 2 điều kiện lọc?
Sao không làm 2 ô điều kiện. Muốn thay đổi điều kiện lọc cứ thay đổi trong 2 ô này rồi bấm nút?

Mình thấy ý tưởng của Ba Tê rất hay khi có thêm các lựa chọn. Nhưng mình không hiểu i,j,k nếu thay đổi ít cột hơn thì phần này có thay đổi không bạn, Hướng dẫn giúp mình nhé. Cảm ơn nhiều
Nhấp chuột vào đây để mở rộng...
Bạn giả lập dữ liệu rồi gửi lên xem thử nhé.
 
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

minhquipk
  • Question Question
Cách nhận biết những ô đã bị thay đổi giá trị khi thay đổi giá trị dữ liệu ở những ô khác
Trả lời
3
Đọc
59
le_vis
L
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
9
Đọc
202
HieuCD
H
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
1
Đọc
43
hoangtuaotrang_hp_vn
H
HeSanbi
  • Đã giải quyết
LocalizeXL v1.72 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
63
Đọc
10K
125479980
125479980
H
Tìm kết quả trả về theo loại
Trả lời
9
Đọc
71
VetMini
V
LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
4
Đọc
78
LongHoang123
LongHoang123
M
  • Question Question
"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel
2 3 4
Trả lời
63
Đọc
15K
SonBDND
S
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
176
thanthanhan0801
T
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
326
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
135
vietduc147258
V
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
34
Đọc
13K
hungbon7890
hungbon7890
A
  • Question Question
code vba chuyển chuỗi thành text
Trả lời
11
Đọc
2K
SonBDND
S
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
11
Đọc
304
HUONGHCKT
H
Tandattb
Xin cách Khắc phục lỗi "Path/File access error"
Trả lời
8
Đọc
286
Tandattb
Tandattb
ThanhPhongDN
Nhờ giúp đỡ về công thức trong google sheet
    • Cười
Trả lời
4
Đọc
83
thuytrangbp28
T
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
35
Đọc
15K
VetMini
V
D
Thống kê dữ liệu theo điều kiện
Trả lời
5
Đọc
138
VetMini
V
noisy
Xin file tính chế độ chuyên cần
    • Cười
Trả lời
0
Đọc
41
noisy
noisy
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
3
Đọc
714
hvnhpro
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
2
Đọc
121
leonguyenz
leonguyenz
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom