Lọc dữ liệu theo điều kiện (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
baquang1984

baquang1984

Thành viên tiêu biểu
Tham gia
3/6/10
Bài viết
429
Được thích
44
Nghề nghiệp
Kỹ sư Lâm nghiệp
Em chào thầy cô và anh chị trên diễn đàn GPE!
Nhờ thầy cô và anh chị giúp em Code VBA lọc dữ liệu theo điều kiện yêu cầu của chương trình là:
Khi em chọn điều kiện lọc ở Ô cell G3 Sheets"DS_Loc" chương trình sẽ lọc dữ liệu từ sheets"Data_Cu" thoản mãn điều kiện ở Ô cell G3 Sheets"DS_Loc" sang Sheets"DS_Loc" và điền dữ liệu vào các cột A, B, C, D, và cột E tuy nhiên khi điền dữ liệu thì có thêm điều kiện là căn cứ vào cột M "Dồn điền" nếu có mã là 1 thì điền dữ liệu ở vùng bên trên, còn nếu không có mã thì điền bên dưới ngăn cách giữa 2 vùng viết một dòng "Các thửa đất không cấp đổi" và điền dữ liệu bên dưới
"Phần này khó giải thích Em làm kết quả mẫu như file đính kèm mong thầy cô và anh chị thông cảm ạ"
Mong được sữ giúp đỡ của thầy cô và anh chị trên diễn đàn em cảm ơn nhiều ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
baquang1984 đã viết:
Em chào thầy cô và anh chị trên diễn đàn GPE!
Nhờ thầy cô và anh chị giúp em Code VBA lọc dữ liệu theo điều kiện yêu cầu của chương trình là:
Khi em chọn điều kiện lọc ở Ô cell G3 Sheets"DS_Loc" chương trình sẽ lọc dữ liệu từ sheets"Data_Cu" thoản mãn điều kiện ở Ô cell G3 Sheets"DS_Loc" sang Sheets"DS_Loc" và điền dữ liệu vào các cột A, B, C, D, và cột E tuy nhiên khi điền dữ liệu thì có thêm điều kiện là căn cứ vào cột M "Dồn điền" nếu có mã là 1 thì điền dữ liệu ở vùng bên trên, còn nếu không có mã thì điền bên dưới ngăn cách giữa 2 vùng viết một dòng "Các thửa đất không cấp đổi" và điền dữ liệu bên dưới
"Phần này khó giải thích Em làm kết quả mẫu như file đính kèm mong thầy cô và anh chị thông cảm ạ"
Mong được sữ giúp đỡ của thầy cô và anh chị trên diễn đàn em cảm ơn nhiều ạ
Nhấp chuột vào đây để mở rộng...
Với bài đăng của em có gì giải thích chưa được rõ mong Thầy cô và anh chị trên diễn đàn phản hồi cho em biết với ạ
Mong được sự giúp đỡ. Em cảm ơn nhiều.
 
Upvote 0
baquang1984 đã viết:
Em chào thầy cô và anh chị trên diễn đàn GPE!
Nhờ thầy cô và anh chị giúp em Code VBA lọc dữ liệu theo điều kiện yêu cầu của chương trình là:
Khi em chọn điều kiện lọc ở Ô cell G3 Sheets"DS_Loc" chương trình sẽ lọc dữ liệu từ sheets"Data_Cu" thoản mãn điều kiện ở Ô cell G3 Sheets"DS_Loc" sang Sheets"DS_Loc" và điền dữ liệu vào các cột A, B, C, D, và cột E tuy nhiên khi điền dữ liệu thì có thêm điều kiện là căn cứ vào cột M "Dồn điền" nếu có mã là 1 thì điền dữ liệu ở vùng bên trên, còn nếu không có mã thì điền bên dưới ngăn cách giữa 2 vùng viết một dòng "Các thửa đất không cấp đổi" và điền dữ liệu bên dưới
"Phần này khó giải thích Em làm kết quả mẫu như file đính kèm mong thầy cô và anh chị thông cảm ạ"
Mong được sữ giúp đỡ của thầy cô và anh chị trên diễn đàn em cảm ơn nhiều ạ
Nhấp chuột vào đây để mở rộng...
Bạn xem thử file
 

File đính kèm

Upvote 0
HieuCD đã viết:
Bạn xem thử file
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh HieuCD Nhiều nhiều ạ chương trình chạy ok tuy nhiên có một chút nữa muốn nhờ anh đó là trong trường hợp khi kiểm tra điều kiện ở Ô cell G3 với dữ liệu ở Cột D Sheets"Data_Cu" mà các thửa của mã đó đều có mã là 1 ví dụ như mã "P 261631" tất cả các thửa đều có mã là 1 do vậy khi lọc sang bảng ở sheets"DS_Loc" thì không ghi dòng "Các thửa đất không cấp đổi" mong được anh và thầy cô, anh chị trên diễn đàn sửa giúp em ạ em cảm ơn nhiều ạ
 
Upvote 0
baquang1984 đã viết:
Em cảm ơn anh HieuCD Nhiều nhiều ạ chương trình chạy ok tuy nhiên có một chút nữa muốn nhờ anh đó là trong trường hợp khi kiểm tra điều kiện ở Ô cell G3 với dữ liệu ở Cột D Sheets"Data_Cu" mà các thửa của mã đó đều có mã là 1 ví dụ như mã "P 261631" tất cả các thửa đều có mã là 1 do vậy khi lọc sang bảng ở sheets"DS_Loc" thì không ghi dòng "Các thửa đất không cấp đổi" mong được anh và thầy cô, anh chị trên diễn đàn sửa giúp em ạ em cảm ơn nhiều ạ
Nhấp chuột vào đây để mở rộng...
chỉnh lại code
Mã: 
Sub Loc()
  Dim dArr(), Arr1(), Arr2(), dk As String, chuoi As String, i As Long, k1 As Long, k2 As Long
  With Sheets("DS_Loc")
    dk = .Range("G3").Value
    chuoi = .Range("I1").Value
  End With
  With Sheets("Data_Cu")
    dArr = .Range("D2:M" & .Range("D" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim Arr1(1 To UBound(dArr), 1 To 5)
  ReDim Arr2(1 To UBound(dArr), 1 To 5)
  For i = 1 To UBound(dArr)
    If dArr(i, 1) = dk Then
      If dArr(i, 10) = 1 Then
        k1 = k1 + 1:        Arr1(k1, 1) = k1
        Arr1(k1, 2) = dArr(i, 5): Arr1(k1, 3) = dArr(i, 6)
        Arr1(k1, 4) = dArr(i, 7): Arr1(k1, 5) = dArr(i, 8)
      Else
        k2 = k2 + 1:        Arr2(k2, 1) = k2
        Arr2(k2, 2) = dArr(i, 5): Arr2(k2, 3) = dArr(i, 6)
        Arr2(k2, 4) = dArr(i, 7): Arr2(k2, 5) = dArr(i, 8)
      End If
    End If
  Next i
  With Sheets("DS_Loc")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    If k1 Then
      .Range("A2:E2").Resize(k1) = Arr1
      .Range("A2:E2").Resize(k1).Borders.LineStyle = 1
    End If
    If k2 Then
      .Range("A" & k1 + 2) = chuoi
      .Range("A" & k1 + 3).Resize(k2, 5) = Arr2
      .Range("A" & k1 + 3).Resize(k2, 5).Borders.LineStyle = 1
    End If
  End With
End Sub
 
Upvote 0
HieuCD đã viết:
chỉnh lại code
Mã: 
Sub Loc()
  Dim dArr(), Arr1(), Arr2(), dk As String, chuoi As String, i As Long, k1 As Long, k2 As Long
  With Sheets("DS_Loc")
    dk = .Range("G3").Value
    chuoi = .Range("I1").Value
  End With
  With Sheets("Data_Cu")
    dArr = .Range("D2:M" & .Range("D" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim Arr1(1 To UBound(dArr), 1 To 5)
  ReDim Arr2(1 To UBound(dArr), 1 To 5)
  For i = 1 To UBound(dArr)
    If dArr(i, 1) = dk Then
      If dArr(i, 10) = 1 Then
        k1 = k1 + 1:        Arr1(k1, 1) = k1
        Arr1(k1, 2) = dArr(i, 5): Arr1(k1, 3) = dArr(i, 6)
        Arr1(k1, 4) = dArr(i, 7): Arr1(k1, 5) = dArr(i, 8)
      Else
        k2 = k2 + 1:        Arr2(k2, 1) = k2
        Arr2(k2, 2) = dArr(i, 5): Arr2(k2, 3) = dArr(i, 6)
        Arr2(k2, 4) = dArr(i, 7): Arr2(k2, 5) = dArr(i, 8)
      End If
    End If
  Next i
  With Sheets("DS_Loc")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    If k1 Then
      .Range("A2:E2").Resize(k1) = Arr1
      .Range("A2:E2").Resize(k1).Borders.LineStyle = 1
    End If
    If k2 Then
      .Range("A" & k1 + 2) = chuoi
      .Range("A" & k1 + 3).Resize(k2, 5) = Arr2
      .Range("A" & k1 + 3).Resize(k2, 5).Borders.LineStyle = 1
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn HieuCD và thầy cô anh chị trên diễn đàn nhiều ạ
 
Upvote 0
HieuCD đã viết:
chỉnh lại code
Mã: 
Sub Loc()
  Dim dArr(), Arr1(), Arr2(), dk As String, chuoi As String, i As Long, k1 As Long, k2 As Long
  With Sheets("DS_Loc")
    dk = .Range("G3").Value
    chuoi = .Range("I1").Value
  End With
  With Sheets("Data_Cu")
    dArr = .Range("D2:M" & .Range("D" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim Arr1(1 To UBound(dArr), 1 To 5)
  ReDim Arr2(1 To UBound(dArr), 1 To 5)
  For i = 1 To UBound(dArr)
    If dArr(i, 1) = dk Then
      If dArr(i, 10) = 1 Then
        k1 = k1 + 1:        Arr1(k1, 1) = k1
        Arr1(k1, 2) = dArr(i, 5): Arr1(k1, 3) = dArr(i, 6)
        Arr1(k1, 4) = dArr(i, 7): Arr1(k1, 5) = dArr(i, 8)
      Else
        k2 = k2 + 1:        Arr2(k2, 1) = k2
        Arr2(k2, 2) = dArr(i, 5): Arr2(k2, 3) = dArr(i, 6)
        Arr2(k2, 4) = dArr(i, 7): Arr2(k2, 5) = dArr(i, 8)
      End If
    End If
  Next i
  With Sheets("DS_Loc")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    If k1 Then
      .Range("A2:E2").Resize(k1) = Arr1
      .Range("A2:E2").Resize(k1).Borders.LineStyle = 1
    End If
    If k2 Then
      .Range("A" & k1 + 2) = chuoi
      .Range("A" & k1 + 3).Resize(k2, 5) = Arr2
      .Range("A" & k1 + 3).Resize(k2, 5).Borders.LineStyle = 1
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh HieuCD cho em hỏi chút là em muốn cố định trong code để cho dữ liệu lọc sang Sheets"DS_Loc" thì chỉ điển trong vùng từ "A2:E21" thì sửa code của anh thế nào ạ. Em cảm ơn anh ạ. Vì em muốn ứng dụng code của anh vào một nội dung khác và vùng dữ liệu ghi ra chỉ từ "A2:E21" mong được sự giúp đỡ của anh ạ. Em cảm ơn anh nhiều nhiều
 
Upvote 0
Đây là chương trình mà em muốn ứng dụng Code của anh. Chương trình sẽ lọc dữ liệu sang Sheets"Don_CapGCN" và điền dữ liệu vào vùng từ ".Range("A26:E46")" khi em chọn điều kiện lọc ở Ô cell O11 Sheets"Don_CapGCN". Tuy nhiên khi em đưa code của anh vào thì chạy bị lỗi và không biết sửa thế nào cho phù hợp làm phiền anh HieuCD sửa giúp em với ạ. Em cảm ơn anh nhiều nhiều
Dưới đây là file đính kèm của em ạ
 

File đính kèm

Upvote 0
baquang1984 đã viết:
Đây là chương trình mà em muốn ứng dụng Code của anh. Chương trình sẽ lọc dữ liệu sang Sheets"Don_CapGCN" và điền dữ liệu vào vùng từ ".Range("A26:E46")" khi em chọn điều kiện lọc ở Ô cell O11 Sheets"Don_CapGCN". Tuy nhiên khi em đưa code của anh vào thì chạy bị lỗi và không biết sửa thế nào cho phù hợp làm phiền anh HieuCD sửa giúp em với ạ. Em cảm ơn anh nhiều nhiều
Dưới đây là file đính kèm của em ạ
Nhấp chuột vào đây để mở rộng...
chỉnh lại code
Mã: 
Sub loc_GCN()
  Dim dArr(), Arr1(), Arr2(), chuoi As String, i As Long, k1 As Long, k2 As Long, dk_loc2 As String, dk_loc As String
  With Sheets("Don_CapGCN")
    chuoi = .Range("Z4").Value
     dk_loc = .Range("O11")
    dk_loc2 = .Range("O12")
  End With
  With Sheets("Data_Cu")
    dArr = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim Arr1(1 To 21, 1 To 5)
  ReDim Arr2(1 To 21, 1 To 5)
  For i = 1 To UBound(dArr)
    If dArr(i, 2) = dk_loc And dArr(i, 4) = dk_loc2 Then
      If dArr(i, 13) = 1 Then
        k1 = k1 + 1:        Arr1(k1, 1) = k1
        Arr1(k1, 2) = dArr(i, 8): Arr1(k1, 3) = dArr(i, 9)
        Arr1(k1, 4) = dArr(i, 10): Arr1(k1, 5) = dArr(i, 11)
      Else
        k2 = k2 + 1:        Arr2(k2, 1) = k2
        Arr2(k2, 2) = dArr(i, 8): Arr2(k2, 3) = dArr(i, 9)
        Arr2(k2, 4) = dArr(i, 10): Arr2(k2, 5) = dArr(i, 11)
      End If
    End If
  Next i
  With Sheets("Don_CapGCN")
    .Range("A26:E46").ClearContents
    .Range("B26:E46").Borders.LineStyle = 1
    .Range("A26:E46").HorizontalAlignment = xlCenter
    If k1 Then
      .Range("A26:E26").Resize(k1) = Arr1
    End If
    If k2 Then
      .Range("A" & k1 + 26) = chuoi
      .Range("B" & k1 + 26).Resize(, 4).Borders(xlInsideVertical).LineStyle = xlNone
      .Range("A" & k1 + 26).HorizontalAlignment = xlGeneral
      .Range("A" & k1 + 27).Resize(k2, 5) = Arr2
    End If
  End With
End Sub
 
Upvote 0
HieuCD đã viết:
chỉnh lại code
Mã: 
Sub loc_GCN()
  Dim dArr(), Arr1(), Arr2(), chuoi As String, i As Long, k1 As Long, k2 As Long, dk_loc2 As String, dk_loc As String
  With Sheets("Don_CapGCN")
    chuoi = .Range("Z4").Value
     dk_loc = .Range("O11")
    dk_loc2 = .Range("O12")
  End With
  With Sheets("Data_Cu")
    dArr = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  ReDim Arr1(1 To 21, 1 To 5)
  ReDim Arr2(1 To 21, 1 To 5)
  For i = 1 To UBound(dArr)
    If dArr(i, 2) = dk_loc And dArr(i, 4) = dk_loc2 Then
      If dArr(i, 13) = 1 Then
        k1 = k1 + 1:        Arr1(k1, 1) = k1
        Arr1(k1, 2) = dArr(i, 8): Arr1(k1, 3) = dArr(i, 9)
        Arr1(k1, 4) = dArr(i, 10): Arr1(k1, 5) = dArr(i, 11)
      Else
        k2 = k2 + 1:        Arr2(k2, 1) = k2
        Arr2(k2, 2) = dArr(i, 8): Arr2(k2, 3) = dArr(i, 9)
        Arr2(k2, 4) = dArr(i, 10): Arr2(k2, 5) = dArr(i, 11)
      End If
    End If
  Next i
  With Sheets("Don_CapGCN")
    .Range("A26:E46").ClearContents
    .Range("B26:E46").Borders.LineStyle = 1
    .Range("A26:E46").HorizontalAlignment = xlCenter
    If k1 Then
      .Range("A26:E26").Resize(k1) = Arr1
    End If
    If k2 Then
      .Range("A" & k1 + 26) = chuoi
      .Range("B" & k1 + 26).Resize(, 4).Borders(xlInsideVertical).LineStyle = xlNone
      .Range("A" & k1 + 26).HorizontalAlignment = xlGeneral
      .Range("A" & k1 + 27).Resize(k2, 5) = Arr2
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh HieuCD nhiều nhiều ạ
 
Upvote 0
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

HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application
Trả lời
1
Đọc
62
VetMini
V
V
  • Question Question
Đếm xếp loại của đơn hàng (1 người xem)
Trả lời
8
Đọc
135
vanlinh_2904
V
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (8 người xem)
Trả lời
2
Đọc
34
newbiexo
N
J
Công thức tính lương khi mỗi tháng tăng lương cơ bản (2 người xem)
Trả lời
2
Đọc
58
jangne88
J
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE. (2 người xem)
Trả lời
0
Đọc
19
HUONGHCKT
H
phatnguyen7301
  • Question Question
Viết code không trùng dữ liệu
Trả lời
3
Đọc
95
VetMini
V
HeSanbi
  • Question Question
GPEStudio - Ứng dụng hỗ trợ tương tác giữa Excel và diễn đàn GPE (2 người xem)
    • Thích
Trả lời
0
Đọc
60
HeSanbi
HeSanbi
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
Trả lời
0
Đọc
32
yeudoi
yeudoi
HeSanbi
  • Question Question
FlashSheet v1.1 - Di chuyển qua lại tức thời giữa các trang tính (1 người xem)
    • Thích
    • Yêu thích
Trả lời
3
Đọc
580
HeSanbi
HeSanbi
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
325
Đọc
24K
ongke0711
ongke0711
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
6
Đọc
220
HeSanbi
HeSanbi
Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ
Trả lời
5
Đọc
88
Manhhung90
Manhhung90
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước.
Trả lời
3
Đọc
94
hanhnguyen12022021
H
N
Không chạy được file VBA
Trả lời
2
Đọc
94
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
214
Đọc
159K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
96
VetMini
V
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
74
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT
Trả lời
0
Đọc
129
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
192
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
160
DinhManh1307
DinhManh1307
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom