Xin giúp đỡ lọc dữ liệu bằng VBA theo năm

Liên hệ QC
A

andyminh

Thành viên chính thức
Tham gia
3/8/12
Bài viết
65
Được thích
4
HI AC GPE

Mình đang làm file theo dõi hợp đồng, thanh toán hợp đồng. Có sheet tổng hợp thông tin của hợp đồng theo năm.
cụ thể: tại Sheet TH, nếu điền năm vào ô L1 (ví dụ là năm 2020), thì tại bảng dưới sẽ lấy thông tin số hợp đồng, nội dung, ngày ký, tên khách hàng, mã khách hàng, giá trị hợp đồng của các hợp đồng đã ký trong năm 2020 TỪ SHEET HD, và lấy giá trị thanh toán của hợp đồng tương ứng từ SHEET TT.

mong AC GPE có thể giúp mình vấn đề này.
Thanks nhiều.
 

File đính kèm

  • filemau.xlsm
    22.1 KB · Đọc: 23
Sắp xếp theo thời gian sắp xếp theo bầu chọn
andyminh đã viết:
HI AC GPE

Mình đang làm file theo dõi hợp đồng, thanh toán hợp đồng. Có sheet tổng hợp thông tin của hợp đồng theo năm.
cụ thể: tại Sheet TH, nếu điền năm vào ô L1 (ví dụ là năm 2020), thì tại bảng dưới sẽ lấy thông tin số hợp đồng, nội dung, ngày ký, tên khách hàng, mã khách hàng, giá trị hợp đồng của các hợp đồng đã ký trong năm 2020 TỪ SHEET HD, và lấy giá trị thanh toán của hợp đồng tương ứng từ SHEET TT.

mong AC GPE có thể giúp mình vấn đề này.
Thanks nhiều.
Nhấp chuột vào đây để mở rộng...
Bạn thử code.
Mã: 
Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, dic As Object, dk As String, nam As Long
    Dim b As Long, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("tonghop")
         nam = .Range("L1").Value
    End With
    With Sheets("HD")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         arr = .Range("C4:J" & lr).Value
    End With
    ReDim kq(1 To UBound(arr), 1 To 10)
    For i = 1 To UBound(arr)
            If Year(arr(i, 6)) = nam Then
               dk = arr(i, 3)
               If Not dic.exists(dk) Then
                  a = a + 1
                  dic.Add dk, a
                  kq(a, 1) = a
                  kq(a, 2) = dk
                  kq(a, 4) = arr(i, 6)
                  kq(a, 5) = arr(i, 6)
                  kq(a, 7) = arr(i, 4)
                  kq(a, 8) = arr(i, 8)
              End If
           End If
   Next i
   With Sheets("TT")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        arr = .Range("C4:J" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 2)
            b = dic.Item(dk)
            If b Then
               kq(b, 9) = kq(b, 9) + arr(i, 8)
               kq(b, 10) = kq(b, 8) - kq(b, 9)
            End If
       Next i
  End With
  With Sheets("tonghop")
       lr = .Range("c" & Rows.Count).End(xlUp).Row
       If lr > 4 Then .Range("B4:K" & lr).ClearContents
       If a Then .Range("b4:K4").Resize(a).Value = kq
  End With
  Set dic = Nothing
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử code.
Mã: 
Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, dic As Object, dk As String, nam As Long
    Dim b As Long, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("tonghop")
         nam = .Range("L1").Value
    End With
    With Sheets("HD")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         arr = .Range("C4:J" & lr).Value
    End With
    ReDim kq(1 To UBound(arr), 1 To 10)
    For i = 1 To UBound(arr)
            If Year(arr(i, 6)) = nam Then
               dk = arr(i, 3)
               If Not dic.exists(dk) Then
                  a = a + 1
                  dic.Add dk, a
                  kq(a, 1) = a
                  kq(a, 2) = dk
                  kq(a, 4) = arr(i, 6)
                  kq(a, 5) = arr(i, 6)
                  kq(a, 7) = arr(i, 4)
                  kq(a, 8) = arr(i, 8)
              End If
           End If
   Next i
   With Sheets("TT")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        arr = .Range("C4:J" & lr).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 2)
            b = dic.Item(dk)
            If b Then
               kq(b, 9) = kq(b, 9) + arr(i, 8)
               kq(b, 10) = kq(b, 8) - kq(b, 9)
            End If
       Next i
  End With
  With Sheets("tonghop")
       lr = .Range("c" & Rows.Count).End(xlUp).Row
       If lr > 4 Then .Range("B4:K" & lr).ClearContents
       If a Then .Range("b4:K4").Resize(a).Value = kq
  End With
  Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Code chạy được rồi bạn, nhưng nó vẫn thiếu một số nội dung của cột bên SHEET TONGHOP: như nội dung HĐ, ngày hết hạn, thời gian thực hiện. Bạn có thể giúp mình thêm những cột này được không
 
Upvote 0
andyminh đã viết:
Code chạy được rồi bạn, nhưng nó vẫn thiếu một số nội dung của cột bên SHEET TONGHOP: như nội dung HĐ, ngày hết hạn, thời gian thực hiện. Bạn có thể giúp mình thêm những cột này được không
Nhấp chuột vào đây để mở rộng...
Trong cái file mẫu bạn gửi còn không có những trường đó mà lấy như thế nào lấy từ đâu bạn giải thích rõ nhé.Không thì bạn tìm hiểu code chỗ gán kết quả rồi sửa nhé.
 
Upvote 0
snow25 đã viết:
Trong cái file mẫu bạn gửi còn không có những trường đó mà lấy như thế nào lấy từ đâu bạn giải thích rõ nhé.Không thì bạn tìm hiểu code chỗ gán kết quả rồi sửa nhé.
Nhấp chuột vào đây để mở rộng...
tất cả dữ liệu đó đều lấy từ sheet HĐ hết bạn ơi, Mình có điền sẵn trong file này, bạn chỉnh lại giúp mình với nhé.
Với mình nhờ bạn thêm xíu nữa,
ở sheet HD tại ô M1, mình gõ gợi ý cụm từ khách hàng (ví dụ ABC) thì ở cột F nó cho danh sách khách hàng thỏa điều kiện ô M1 (lấy dữ liệu khách hàng tại cột B -SHEET KH) được không bạn.
Thanks bạn nhiều.
 

File đính kèm

  • filemau.xlsm
    35.7 KB · Đọc: 8
Upvote 0
AC GPE nào rảnh giúp mình vấn đề này với :)
 
Upvote 0
Mình cũng mới nhận thêm việc theo dõi, thanh toán hợp đồng, nhìn file bạn mới nhận ra là mình thiếu nhiều thông tin cần theo dõi quá
Thanks

 
Upvote 0
andyminh đã viết:
tất cả dữ liệu đó đều lấy từ sheet HĐ hết bạn ơi, Mình có điền sẵn trong file này, bạn chỉnh lại giúp mình với nhé.
Với mình nhờ bạn thêm xíu nữa,
ở sheet HD tại ô M1, mình gõ gợi ý cụm từ khách hàng (ví dụ ABC) thì ở cột F nó cho danh sách khách hàng thỏa điều kiện ô M1 (lấy dữ liệu khách hàng tại cột B -SHEET KH) được không bạn.
Thanks bạn nhiều.
Nhấp chuột vào đây để mở rộng...
Bạn xem thử nhé
Mã: 
==========================Module
Sub LocTheoKhachHang()
    Dim duLieu, ketQua As Variant
    Dim row_duLieu, row_ketQua As Long
    Dim dieuKien As String
       
    On Error Resume Next
    dieuKien = Sheets("HD").Range("M1").Value
    duLieu = Sheets("KH").Range("B3:B" & Sheets("KH").Range("B99999").End(xlUp).Row).Value
    ReDim ketQua(1 To UBound(duLieu), 1 To 1)
    For row_duLieu = 1 To UBound(duLieu)
        If LCase(duLieu(row_duLieu, 1)) Like "*" & LCase(dieuKien) & "*" Then
            row_ketQua = row_ketQua + 1
            ketQua(row_ketQua, 1) = duLieu(row_duLieu, 1)
        End If
    Next row_duLieu
   
    Sheets("HD").Range("F4:F" & Sheets("HD").Range("F99999").End(xlUp).Row).ClearContents
    Sheets("HD").Range("F4").Resize(row_ketQua, 1) = ketQua
End Sub


==========================Gán Module lên M1 sheets HD
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M1")) Is Nothing And Target.Count = 1 Then
        Call LocTheoKhachHang
    End If
End Sub
 

File đính kèm

  • filemau_y 2.xlsm
    38.1 KB · Đọc: 11
Upvote 0
vivancuongneu đã viết:
Bạn xem thử nhé
==========================Module Sub LocTheoKhachHang() Dim duLieu, ketQua As Variant Dim row_duLieu, row_ketQua As Long Dim dieuKien As String On Error Resume Next dieuKien = Sheets("HD").Range("M1").Value duLieu = Sheets("KH").Range("B3:B" & Sheets("KH").Range("B99999").End(xlUp).Row).Value ReDim ketQua(1 To UBound(duLieu), 1 To 1) For row_duLieu = 1 To UBound(duLieu) If LCase(duLieu(row_duLieu, 1)) Like "*" & LCase(dieuKien) & "*" Then row_ketQua = row_ketQua + 1 ketQua(row_ketQua, 1) = duLieu(row_duLieu, 1) End If Next row_duLieu Sheets("HD").Range("F4:F" & Sheets("HD").Range("F99999").End(xlUp).Row).ClearContents Sheets("HD").Range("F4").Resize(row_ketQua, 1) = ketQua End Sub ==========================Gán Module lên M1 sheets HD Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("M1")) Is Nothing And Target.Count = 1 Then Call LocTheoKhachHang End If End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn giúp đỡ của bạn, nhưng code chạy không đúng ý mình rồi (do mình nêu không rỏ đề bài), ý của mình là tại ô tìm kiếm M1 của sheet HĐ, mình gõ gợi ý thì tại cột F, nó liệt kê danh sách khách hàng thỏa điều kiện tìm kiếm để mình chọn.
VÍ DỤ: ở ô M1 mình đánh là TIẾN PHÁT, THÌ TẠI DÒNG MÌNH MUỐN THÊM SỐ HỢP ĐỒNG (dòng 5 chẵng hạn), ở ô F5 nó sẽ list danh sách các khách hàng có từ TỪ TIẾN PHÁT ĐỂ MÌNH CHỌN.
 

File đính kèm

  • 1.png
    1.png
    12.5 KB · Đọc: 13
  • 2.png
    2.png
    12.7 KB · Đọc: 14
Upvote 0
Thử lại nhé
Tạo DATA VALIDATION với công thức =OFFSET(DanhMuc!$A$2,0,0,COUNTA(DanhMuc!$A:$A)-1,1)
Untitled.png
 

File đính kèm

  • filemau_y 2_edited.xlsm
    39.5 KB · Đọc: 8
Upvote 0
vivancuongneu đã viết:
Thử lại nhé
Tạo DATA VALIDATION với công thức =OFFSET(DanhMuc!$A$2,0,0,COUNTA(DanhMuc!$A:$A)-1,1)
View attachment 253690
Nhấp chuột vào đây để mở rộng...
Vẫn chưa được bạn ơi, như file bạn thử, nếu đầu mình đánh ương -> nó liệt kê xong 2 tên cty, mình chọn phú thương xong. xuống dòng tiếp theo mình gõ ABC để liệt kê cty ABC để chọn thì nó vẫn liệt kê 2 cty (phú thương, thành vương) của cái trên chứ ko theo gợi ý mới của mình.
Bài đã được tự động gộp:

andyminh đã viết:
Vẫn chưa được bạn ơi, như file bạn thử, nếu đầu mình đánh ương -> nó liệt kê xong 2 tên cty, mình chọn phú thương xong. xuống dòng tiếp theo mình gõ ABC để liệt kê cty ABC để chọn thì nó vẫn liệt kê 2 cty (phú thương, thành vương) của cái trên chứ ko theo gợi ý mới của mình.
Nhấp chuột vào đây để mở rộng...
à được rồi, do mình không enter để xử lý lệnh, cảm ơn bạn rất nhiều.
 

File đính kèm

  • 3.png
    3.png
    142 KB · Đọc: 5
Upvote 0
vivancuongneu đã viết:
Bạn xem thử nhé
Mã: 
==========================Module
Sub LocTheoKhachHang()
    Dim duLieu, ketQua As Variant
    Dim row_duLieu, row_ketQua As Long
    Dim dieuKien As String
      
    On Error Resume Next
    dieuKien = Sheets("HD").Range("M1").Value
    duLieu = Sheets("KH").Range("B3:B" & Sheets("KH").Range("B99999").End(xlUp).Row).Value
    ReDim ketQua(1 To UBound(duLieu), 1 To 1)
    For row_duLieu = 1 To UBound(duLieu)
        If LCase(duLieu(row_duLieu, 1)) Like "*" & LCase(dieuKien) & "*" Then
            row_ketQua = row_ketQua + 1
            ketQua(row_ketQua, 1) = duLieu(row_duLieu, 1)
        End If
    Next row_duLieu
  
    Sheets("HD").Range("F4:F" & Sheets("HD").Range("F99999").End(xlUp).Row).ClearContents
    Sheets("HD").Range("F4").Resize(row_ketQua, 1) = ketQua
End Sub


==========================Gán Module lên M1 sheets HD
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M1")) Is Nothing And Target.Count = 1 Then
        Call LocTheoKhachHang
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Code hay nhưng giá ĐẶT THÊM ĐIỀU KIỆN M1 =0 thì "kết quả" ="" thì hoàn chỉnh quá; Vì chẽ nhẽ khi có hàng 2-3 nghìn khách hàng mà M1 = 0 nó vẫn liệt kê toàn bộ số khách hàng đó thì có vẻ hơi bất tiện bạn nhỉ - Xin lỗi bạn nếu góp ý này không chuẩn thì cho mình xin lại lời nhé
 
Upvote 0
andyminh đã viết:
. . . nhưng nó vẫn thiếu một số nội dung của cột bên SHEET TONGHOP: như nội dung HĐ, ngày hết hạn, thời gian thực hiện. Bạn có thể giúp mình thêm những cột này được không
Nhấp chuột vào đây để mở rộng...
Do cách ghi của bạn thiếu cụ thể nên trở thành khó ưa & người khác không giúp bạn thôi;
Lí ra bạn phải ghi vầy:
Lấy dữ liệu thỏa điều kiện (về năm) của cột [Nội dung đàm phán] sang cột [Nội dung] của trang 'TONGHOP' (Tên trang tính ở đây nên là 'TongHop' cho dễ với người mắt kém)
Có nghĩa là 1 khi 2 tên trường không trùng tên thì nên viết cụ thể ra như vậy; Có như vậy bạn mới không làm khó cộng đồng!

ở sheet HD tại ô M1, mình gõ gợi ý cụm từ khách hàng (ví dụ ABC) thì ở cột F nó cho danh sách khách hàng thỏa điều kiện ô M1 (lấy dữ liệu khách hàng tại cột B -SHEET KH) được không bạn.
Nhấp chuột vào đây để mở rộng...
Bạn muốn AutoFilter hay lọc (theo mã khách hàng cần thiết) ra 1 nơi nào ở trang tính nào?

Tựu chung là viết những gì cần thiết để người khác hiểu ngay mình!
 
Upvote 0
le_vis đã viết:
Code hay nhưng giá ĐẶT THÊM ĐIỀU KIỆN M1 =0 thì "kết quả" ="" thì hoàn chỉnh quá; Vì chẽ nhẽ khi có hàng 2-3 nghìn khách hàng mà M1 = 0 nó vẫn liệt kê toàn bộ số khách hàng đó thì có vẻ hơi bất tiện bạn nhỉ - Xin lỗi bạn nếu góp ý này không chuẩn thì cho mình xin lại lời nhé
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn, tại bình thường code này mình làm ghi kết quả trên listbox nên muốn khi ô điều kiện trống nó hiện ra toàn bộ danh sách, lúc đưa kết quả vào bảng tính quên không sửa lại code :yes:
 
Upvote 0
SA_DQ đã viết:
Do cách ghi của bạn thiếu cụ thể nên trở thành khó ưa & người khác không giúp bạn thôi;
Lí ra bạn phải ghi vầy:
Lấy dữ liệu thỏa điều kiện (về năm) của cột [Nội dung đàm phán] sang cột [Nội dung] của trang 'TONGHOP' (Tên trang tính ở đây nên là 'TongHop' cho dễ với người mắt kém)
Có nghĩa là 1 khi 2 tên trường không trùng tên thì nên viết cụ thể ra như vậy; Có như vậy bạn mới không làm khó cộng đồng!


Bạn muốn AutoFilter hay lọc (theo mã khách hàng cần thiết) ra 1 nơi nào ở trang tính nào?

Tựu chung là viết những gì cần thiết để người khác hiểu ngay mình!
Nhấp chuột vào đây để mở rộng...
Cảm ơn góp ý của bạn, do mình cũng chưa rành cách trình bày nên còn thiếu sót, sẽ cố gắng ghi rỏ nội dung mình cần giúp hơn.
Tiện đây mình cũng xin AE GPE giúp mình vấn đề này nữa:
ở SHEET TT, cột D, lấy dữ liệu thỏa điều kiện của cột C (HĐ, ĐĐH) từ SHEET DDH và SHEET HD.
cụ thể:
- Nếu ở cột C (SHEET TT) mình chọn là HĐ thì ở cột D (Sheet TT) sẽ auto Filter danh sách số các hợp đồng đã ký (danh sách Cột E sheet HĐ)
- Nếu ở cột C (SHEET TT) mình chọn là ĐĐH thì ở cột D (Sheet TT) sẽ auto Filter danh sách số các đơn đặt hàng đã ký (danh sách Cột C sheet DDH).
Cảm ơn AC GPE nhiều.
 

File đính kèm

  • filemau.xlsm
    39 KB · Đọc: 6
Upvote 0
andyminh đã viết:
- Nếu ở cột C (SHEET TT) mình chọn là HĐ thì ở cột D (Sheet TT) sẽ auto Filter danh sách số các hợp đồng đã ký (danh sách Cột E sheet HĐ)
- Nếu ở cột C (SHEET TT) mình chọn là ĐĐH thì ở cột D (Sheet TT) sẽ auto Filter danh sách số các đơn đặt hàng đã ký (danh sách Cột C sheet DDH).
Nhấp chuột vào đây để mở rộng...
Bạn thử xem file, nếu đúng ý của bạn thì xài & chúc vui.
 

File đính kèm

  • GPE.rar
    41.7 KB · Đọc: 11
Upvote 0
SA_DQ đã viết:
Bạn thử xem file, nếu đúng ý của bạn thì xài & chúc vui.
Nhấp chuột vào đây để mở rộng...
Ở đây mình thấy nó list tất cả ah bạn ơi. (HÌNH 1)
- mình muốn nếu C13 chọn là HĐ thì D13 nó chỉ list danh sách các hợp đồng, còn Đơn đặt hàng thì ko hiện và ngược lại. (hình 2, 3)
 

File đính kèm

  • 1.png
    1.png
    8.5 KB · Đọc: 12
  • 2.png
    2.png
    5.9 KB · Đọc: 11
  • 3.png
    3.png
    5 KB · Đọc: 12
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

ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
246
Đọc
13K
trannguyen197
T
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
28
Đọc
602
Tuấn Bụng Bự
Tuấn Bụng Bự
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
9
Đọc
236
ptm0412
ptm0412
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
14
Đọc
269
ptm0412
ptm0412
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
7
Đọc
117
Hoàng Tuấn 868
H
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
212
Hoàng Tuấn 868
H
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
6
Đọc
108
tigertiger
tigertiger
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
H
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
3
Đọc
114
batista911
B
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
1
Đọc
92
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
5
Đọc
155
kimtanmap
kimtanmap
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
1
Đọc
77
hoangtuaotrang_hp_vn
H
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
49
huynhnhu1234
huynhnhu1234
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
127
tranvansau278
T
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
119
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
164
zarra
zarra
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
296
anhdepjai
A
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
17
Đọc
20K
DeTong
D
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
306
cantl
C
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

Back
Top Bottom