Lọc dữ liệu các sheet khác nhau về 1 sheet dùng VBA (4 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)
T

tanduyk8

Thành viên mới
Tham gia
29/12/18
Bài viết
11
Được thích
0
Hi A/C trong diễn đàn ,
Em mới tham gia viết code và có làm 1 bài tập về nhập dữ liệu và lọc dữ liệu trong cty em .
Về phần nhập dữ liệu em đã hoàn thiện rồi , nhưng sang đến phần lọc dữ liệu em đang bị mắc và kiến thức có hạn,
nên em muốn đăng lên đây để nhờ a/c trong diễn đàn giúp em ạ .

Bảng 1 :
Có 5 công đoạn lọc dữ liệu từ I -> V dữ liệu lọc là giống nhau giữa các công đoạn .
có 5 items cần lọc là Date , time , model , PO# và Lot# ( có thể lọc 1 trong các điều kiện ,và không bắt buộc lọc full )
Sau khi đã chọn các item để lọc sẽ tiến hành nhấn vào nut " Underfill result " -> kết quả sẽ lọc hết dữ liệu của bảng 2 , bảng 3 và bảng 4 như mình chọn và tính tổng các bảng đó theo những hạng mục :
1. Input Q'ty ( tính tổng của bảng 2 )
2. OK Q'ty ( Tính tổng của bảng 2 )
3. NG Q;ty ( Tính tổng của bảng 2 )
4. NG Q'ty Detail ( Tính tổng của bảng 3)
5. Ship Out Q'ty ( Tính tổng của bảng 4 )
6. Remain Q'ty ( Tính tổng của bảng 2 )
7. Balance Qty ( Số lượng sau khi lấy input trừ hết các ô còn lại )

Nhấn nut " Reset " để clear bộ lọc của các bảng .

Em rất mong nhận được sự giúp đỡ của mọi người . em cám ơn .

File đính kèm em gửi kèm theo ạ .
PS : em có làm 1 chút về cách lọc trong underfil sheet nhưng vẫn chưa khả thi ạ .
Bảng 1
219657


Bảng 2
219658


Bảng 3
219659


Bảng 4

219660
 

File đính kèm

tanduyk8 đã viết:
Hi A/C trong diễn đàn ,
Em mới tham gia viết code và có làm 1 bài tập về nhập dữ liệu và lọc dữ liệu trong cty em .
Về phần nhập dữ liệu em đã hoàn thiện rồi , nhưng sang đến phần lọc dữ liệu em đang bị mắc và kiến thức có hạn,
nên em muốn đăng lên đây để nhờ a/c trong diễn đàn giúp em ạ .

Bảng 1 :
Có 5 công đoạn lọc dữ liệu từ I -> V dữ liệu lọc là giống nhau giữa các công đoạn .
có 5 items cần lọc là Date , time , model , PO# và Lot# ( có thể lọc 1 trong các điều kiện ,và không bắt buộc lọc full )
Sau khi đã chọn các item để lọc sẽ tiến hành nhấn vào nut " Underfill result " -> kết quả sẽ lọc hết dữ liệu của bảng 2 , bảng 3 và bảng 4 như mình chọn và tính tổng các bảng đó theo những hạng mục :
1. Input Q'ty ( tính tổng của bảng 2 )
2. OK Q'ty ( Tính tổng của bảng 2 )
3. NG Q;ty ( Tính tổng của bảng 2 )
4. NG Q'ty Detail ( Tính tổng của bảng 3)
5. Ship Out Q'ty ( Tính tổng của bảng 4 )
6. Remain Q'ty ( Tính tổng của bảng 2 )
7. Balance Qty ( Số lượng sau khi lấy input trừ hết các ô còn lại )

Nhấn nut " Reset " để clear bộ lọc của các bảng .

Em rất mong nhận được sự giúp đỡ của mọi người . em cám ơn .

File đính kèm em gửi kèm theo ạ .
PS : em có làm 1 chút về cách lọc trong underfil sheet nhưng vẫn chưa khả thi ạ .
Bảng 1
View attachment 219657


Bảng 2
View attachment 219658


Bảng 3
View attachment 219659


Bảng 4

View attachment 219660
Nhấp chuột vào đây để mở rộng...
Bạn thử code này.Xong làm những cái khác.Và sửa cho phù hợp.
Mã: 
Sub tinhtong()
    Dim arr, i As Long, j As Long, kq(1 To 1, 1 To 7), lr As Long, dks As String, dk As String
    With Sheets("Overview")
         dk = .Range("C9").Value2 & "#" & .Range("C10").Value & "#" & .Range("C11").Value & "#" & .Range("C12").Value & "#" & .Range("C13").Value
    End With
    With Sheets("Underfillinput")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:M" & lr).Value
             For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                 If UCase(dk) = UCase(dks) Then
                    kq(1, 1) = kq(1, 1) + arr(i, 9)
                    kq(1, 2) = kq(1, 2) + arr(i, 10)
                    kq(1, 3) = kq(1, 3) + arr(i, 11)
                    kq(1, 6) = kq(1, 6) + arr(i, 12)
                 End If
             Next i
        End If
  End With
  With Sheets("Underfill NG")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:K" & lr).Value
              For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 4) = kq(1, 4) + arr(i, 9)
                 End If
              Next i
        End If
 End With
  With Sheets("Underfill Ship Out ")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:J" & lr).Value
              For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 5) = kq(1, 5) + arr(i, 7)
                 End If
              Next i
        End If
 End With
    kq(1, 7) = kq(1, 1) - kq(1, 2) - kq(1, 3) - kq(1, 4) - kq(1, 5) - kq(1, 6)
    With Sheets("Overview")
          .Range("E10").Value = kq(1, 1)
          .Range("G10").Value = kq(1, 2)
          .Range("I10").Value = kq(1, 3)
          .Range("K10").Value = kq(1, 4)
          .Range("M10").Value = kq(1, 5)
          .Range("O10").Value = kq(1, 6)
          .Range("Q10").Value = kq(1, 7)
    End With
End Sub
 
snow25 đã viết:
Bạn thử code này.Xong làm những cái khác.Và sửa cho phù hợp.
Mã: 
Sub tinhtong()
    Dim arr, i As Long, j As Long, kq(1 To 1, 1 To 7), lr As Long, dks As String, dk As String
    With Sheets("Overview")
         dk = .Range("C9").Value2 & "#" & .Range("C10").Value & "#" & .Range("C11").Value & "#" & .Range("C12").Value & "#" & .Range("C13").Value
    End With
    With Sheets("Underfillinput")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:M" & lr).Value
             For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                 If UCase(dk) = UCase(dks) Then
                    kq(1, 1) = kq(1, 1) + arr(i, 9)
                    kq(1, 2) = kq(1, 2) + arr(i, 10)
                    kq(1, 3) = kq(1, 3) + arr(i, 11)
                    kq(1, 6) = kq(1, 6) + arr(i, 12)
                 End If
             Next i
        End If
  End With
  With Sheets("Underfill NG")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:K" & lr).Value
              For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 4) = kq(1, 4) + arr(i, 9)
                 End If
              Next i
        End If
End With
  With Sheets("Underfill Ship Out ")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:J" & lr).Value
              For i = 1 To UBound(arr)
                 dks = CLng(arr(i, 2)) & "#" & arr(i, 4) & "#" & arr(i, 5) & "#" & arr(i, 6) & "#" & arr(i, 7)
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 5) = kq(1, 5) + arr(i, 7)
                 End If
              Next i
        End If
End With
    kq(1, 7) = kq(1, 1) - kq(1, 2) - kq(1, 3) - kq(1, 4) - kq(1, 5) - kq(1, 6)
    With Sheets("Overview")
          .Range("E10").Value = kq(1, 1)
          .Range("G10").Value = kq(1, 2)
          .Range("I10").Value = kq(1, 3)
          .Range("K10").Value = kq(1, 4)
          .Range("M10").Value = kq(1, 5)
          .Range("O10").Value = kq(1, 6)
          .Range("Q10").Value = kq(1, 7)
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Hi Bạn ,
Mình rất cám ơn bạnđã support mình .
Mình có copy và check nhưng nó báo lỗi bạn ạ
Mình chọn điều kiện ở sheet " overview " . Bạn check giúp mình xem ntn

219674



219672

219673
 

File đính kèm

Hi Snow 25 ,

Mình đã chỉnhđược rồi bạn ạ ,
nhưng vấn đề phát sinh ở đây là mục lọc dữ liệu ,có 5 mục lọc là :Date , time , Model , PO , Lot ,điều kiện lọc ở đây có thể lọc 1 hay nhiều điều kiện cùng lúc , không bắt buộc phải lọc hết 5 điều kiện này .
Lọc dữ liệu Date thì lọc từng ngay hay lọc theo nhiều ngày .
Mong bạn hỗ trợ .

VD1 : mình lọc 1 dữ liệu " Date " còn các ô khác để trống .

Date6/20/2019
Time
Model
PO#
LOT#

VD 2 : Lọc dữ liệu theo Date - Model - PO-Lot , ko lọc Time


Date6/20/2019
Time
ModelYPRU2
PO#Y190619001
LOT#0-096-0030
 
tanduyk8 đã viết:
Hi Snow 25 ,

Mình đã chỉnhđược rồi bạn ạ ,
nhưng vấn đề phát sinh ở đây là mục lọc dữ liệu ,có 5 mục lọc là :Date , time , Model , PO , Lot ,điều kiện lọc ở đây có thể lọc 1 hay nhiều điều kiện cùng lúc , không bắt buộc phải lọc hết 5 điều kiện này .
Lọc dữ liệu Date thì lọc từng ngay hay lọc theo nhiều ngày .
Mong bạn hỗ trợ .

VD1 : mình lọc 1 dữ liệu " Date " còn các ô khác để trống .

Date6/20/2019
Time
Model
PO#
LOT#

VD 2 : Lọc dữ liệu theo Date - Model - PO-Lot , ko lọc Time


Date6/20/2019
Time
ModelYPRU2
PO#Y190619001
LOT#0-096-0030
Nhấp chuột vào đây để mở rộng...
Bạn thử code này.
Mã: 
Sub tinhtong()
    Dim arr, i As Long, j As Long, kq(1 To 1, 1 To 7), lr As Long, dks As String, dk As String, T, T1, vitri(), a As Integer, k As Integer
    T1 = Array(2, 4, 5, 6, 7)
    With Sheets("Overview")
         T = .Range("C9:C13").Value2
         For i = 1 To UBound(T)
             If T(i, 1) <> Empty Then
                a = a + 1
                dk = dk & "#" & T(i, 1)
                ReDim Preserve vitri(1 To a)
                vitri(a) = T1(i - 1)
             End If
         Next i
    End With
    With Sheets("Underfillinput")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:M" & lr).Value2
             For i = 1 To UBound(arr)
                 dks = Empty
                 For k = 1 To a
                     dks = dks & "#" & arr(i, vitri(k))
                 Next k
                 If UCase(dk) = UCase(dks) Then
                    kq(1, 1) = kq(1, 1) + arr(i, 9)
                    kq(1, 2) = kq(1, 2) + arr(i, 10)
                    kq(1, 3) = kq(1, 3) + arr(i, 11)
                    kq(1, 6) = kq(1, 6) + arr(i, 12)
                 End If
             Next i
        End If
  End With
  With Sheets("Underfill NG")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:K" & lr).Value
              For i = 1 To UBound(arr)
                 dks = Empty
                 For k = 1 To a
                     dks = dks & "#" & arr(i, vitri(k))
                 Next k
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 4) = kq(1, 4) + arr(i, 9)
                 End If
              Next i
        End If
End With
  With Sheets("Underfill Ship Out ")
       lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr > 5 Then
             arr = .Range("A6:J" & lr).Value
              For i = 1 To UBound(arr)
                 dks = Empty
                 For k = 1 To a
                     dks = dks & "#" & arr(i, vitri(k))
                 Next k
                  If UCase(dk) = UCase(dks) Then
                       kq(1, 5) = kq(1, 5) + arr(i, 7)
                 End If
              Next i
        End If
End With
    kq(1, 7) = kq(1, 1) - kq(1, 2) - kq(1, 3) - kq(1, 4) - kq(1, 5) - kq(1, 6)
    With Sheets("Overview")
          .Range("E10").Value = kq(1, 1)
          .Range("G10").Value = kq(1, 2)
          .Range("I10").Value = kq(1, 3)
          .Range("K10").Value = kq(1, 4)
          .Range("M10").Value = kq(1, 5)
          .Range("O10").Value = kq(1, 6)
          .Range("Q10").Value = kq(1, 7)
    End With
End Sub
 
Hi Snow 25 ,
Rất cảm ơn bạn về những mục này . mình đã nhập và điều chỉnh ok rồi .
Chúc bạn ngày mới vui vẻ và thành công
 
Hi Snow 25 ,


Mình muốn tổng hợp thêm phần chi tiết lỗi để vẽđồ thị ,
bạn giúp mình thêm 1 code vẫn là lọc dữ liệu và copy tên lỗi sang 1 sheet mới và tính tổng những lỗi trùng nhau .
VD mình làm ntn , Mong bạn giúp đỡ để mình có thể hoàn thiện hơn chương trình . Thanks bạn nhiều .
1. Mình lọc dữ liễu cũng như vậy , theo Date , time , PO , Model , Lot
Và mình lọc chi tiết lỗi ở sheet " Underfill NG " và coppy tên lỗi và tính tổng sang sheet " NG detail "

Sheet " NG detail "
Cột " Chart Defect Name " sẽ tự động điền từ A-> Z tương ứng bên cột " Defect name " có thông tin .
219714

Sheet " Underfill NG "
Mình sẽ lấy tên lỗiở cột " NG Detail " và số lượng lỗi tương ứng ở cột " NG Q'ty "để copy sang bên sheet " NG Detail "

219715
 
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

thlpro
Cách lập Công thức tính số ngày nghỉ AL, ưu tiên tính 2024 trước rồi mới tính 2025 (7 người xem)
Trả lời
4
Đọc
58
ptm0412
ptm0412
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (1 người xem)
Trả lời
4
Đọc
150
VetMini
V
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (2 người xem)
Trả lời
16
Đọc
256
VetMini
V
G
Tách công thức ra khỏi chuỗi và tính kết quả? (1 người xem)
2
Trả lời
22
Đọc
2K
gobi
gobi
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
5
Đọc
112
VetMini
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
346
Đọc
31K
Vandat1607
V
M
Xin giúp đỡ làm công thức điều kiện (1 người xem)
Trả lời
2
Đọc
134
Hoangkhang01213
Hoangkhang01213
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt
Trả lời
4
Đọc
182
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
304
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
171
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
582
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
149
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (2 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
813
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
249
Hoàng Tuấn 868
H
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
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom