Tìm kiếm theo nhiều điều kiện (5 người xem)

vulunktheky · 23/1/19

Chào các anh chị và các bạn!
Mình có file dữ liệu được trích xuất từ hệ thống Oracle cua công ty. và yêu cầu ở đây là mình cần lấy dữ liệu: Order No, ART và theo từng SIZE với điều kiện là theo LINE: E607,F2..... và chỉ lấy dòng nhập kho (tô màu cam sheet du lieu).
Xin cảm ơn các anh chị và các bạn.

snow25 · 23/1/19

vulunktheky đã viết:
Chào các anh chị và các bạn!
Mình có file dữ liệu được trích xuất từ hệ thống Oracle cua công ty. và yêu cầu ở đây là mình cần lấy dữ liệu: Order No, ART và theo từng SIZE với điều kiện là theo LINE: E607,F2..... và chỉ lấy dòng nhập kho (tô màu cam sheet du lieu).
Xin cảm ơn các anh chị và các bạn.

Lấy cái gì cho kết quả mẫu xem nào.Mà dùng VBA được không.

vulunktheky · 23/1/19

snow25 đã viết:
Lấy cái gì cho kết quả mẫu xem nào.Mà dùng VBA được không.

nếu dùng VBA được thì anh hỗ trợ giúp em, e không biết về VBA. Cảm ơn anh.

snow25 · 23/1/19

vulunktheky đã viết:
nếu dùng VBA được thì anh hỗ trợ giúp em, e không biết về VBA. Cảm ơn anh.

Bạn cho kết quả cụ thể và nói rõ là lấy như thế nào đi.

vulunktheky · 23/1/19

kết quả trả về là như thế này anh.

snow25 · 23/1/19

vulunktheky đã viết:
kết quả trả về là như thế này anh.View attachment 211487

Ví dụ như thế này ghi dữ liệu kiểu gì vậy.Nó có 2 cái giống nhau đều là 10 nhưng 1 cái là 0 và 1 cái là 186.

snow25 · 23/1/19

vulunktheky đã viết:
kết quả trả về là như thế này anh.View attachment 211487

Bạn xem kết quả có đúng không nhé.Ở đây nếu trùng mình cộng vào với nhau.

Mã:

Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, j As Integer, dk As String, dic As Object, a As Long, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("DU LIEU")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     arr = .Range("A2:W" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
End With
    For i = 3 To UBound(arr, 1)
        If arr(i, 1) <> "Line Line Line" And arr(i, 1) <> Empty Then
           dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
           If Not dic.exists(dks) Then
             dic.Add dks, "KK"
             a = a + 1
             arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2): arr1(a, 3) = arr(i, 3)
             For j = 4 To UBound(arr, 2)
               If arr(i - 1, j) <> Empty Then
                  dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(i - 1, j)
                  If Not dic.exists(dk) Then
                     dic.Add dk, arr(i, j)
                  Else
                     dic.Item(dk) = dic.Item(dk) + arr(i, j)
                  End If
               End If
             Next j
        End If
     End If
Next i
With Sheets("Tim kiem")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr > 3 Then .Range("B3:AA" & lr).ClearContents
     If a Then .Range("B3").Resize(a, 3).Value = arr1
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     arr = .Range("B1:AA" & lr).Value
     For i = 1 To UBound(arr, 1)
         For j = 4 To UBound(arr, 2)
            dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(1, j)
           If dic.exists(dk) Then
              arr(i, j) = dic.Item(dk)
           End If
       Next j
     Next i
      .Range("B1:AA" & lr).Value = arr
End With
End Sub

vulunktheky · 23/1/19

Nếu xuất hiện trùng như vậy thì chỉ lấy kết quả phía trên (có số lượng chi tiết từng size) thôi anh.

Bài đã được tự động gộp: 23/1/19

snow25 đã viết:

Bạn xem kết quả có đúng không nhé.

Mã:

Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, j As Integer, dk As String, dic As Object, a As Long, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("DU LIEU")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     arr = .Range("A2:W" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
End With
    For i = 3 To UBound(arr, 1)
        If arr(i, 1) <> "Line Line Line" And arr(i, 1) <> Empty Then
           dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
           If Not dic.exists(dks) Then
             dic.Add dks, "KK"
             a = a + 1
             arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2): arr1(a, 3) = arr(i, 3)
             For j = 4 To UBound(arr, 2)
               If arr(i - 1, j) <> Empty Then
                  dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(i - 1, j)
                  If Not dic.exists(dk) Then
                     dic.Add dk, arr(i, j)
                  Else
                     dic.Item(dk) = dic.Item(dk) + arr(i, j)
                  End If
               End If
             Next j
        End If
     End If
Next i
With Sheets("Tim kiem")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr > 3 Then .Range("B3:AA" & lr).ClearContents
     If a Then .Range("B3").Resize(a, 3).Value = arr1
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     arr = .Range("B1:AA" & lr).Value
     For i = 1 To UBound(arr, 1)
         For j = 4 To UBound(arr, 2)
            dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(1, j)
           If dic.exists(dk) Then
              arr(i, j) = dic.Item(dk)
           End If
       Next j
     Next i
      .Range("B1:AA" & lr).Value = arr
End With
End Sub

Cảm ơn anh, e sẽ kiểm tra.

vulunktheky · 23/1/19

snow25 đã viết:

Bạn xem kết quả có đúng không nhé.Ở đây nếu trùng mình cộng vào với nhau.

Mã:

Sub laydulieu()
Dim arr, arr1, lr As Long, i As Long, j As Integer, dk As String, dic As Object, a As Long, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("DU LIEU")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     If lr < 4 Then Exit Sub
     arr = .Range("A2:W" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 3)
End With
    For i = 3 To UBound(arr, 1)
        If arr(i, 1) <> "Line Line Line" And arr(i, 1) <> Empty Then
           dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
           If Not dic.exists(dks) Then
             dic.Add dks, "KK"
             a = a + 1
             arr1(a, 1) = arr(i, 1): arr1(a, 2) = arr(i, 2): arr1(a, 3) = arr(i, 3)
             For j = 4 To UBound(arr, 2)
               If arr(i - 1, j) <> Empty Then
                  dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(i - 1, j)
                  If Not dic.exists(dk) Then
                     dic.Add dk, arr(i, j)
                  Else
                     dic.Item(dk) = dic.Item(dk) + arr(i, j)
                  End If
               End If
             Next j
        End If
     End If
Next i
With Sheets("Tim kiem")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr > 3 Then .Range("B3:AA" & lr).ClearContents
     If a Then .Range("B3").Resize(a, 3).Value = arr1
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     arr = .Range("B1:AA" & lr).Value
     For i = 1 To UBound(arr, 1)
         For j = 4 To UBound(arr, 2)
            dk = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & arr(1, j)
           If dic.exists(dk) Then
              arr(i, j) = dic.Item(dk)
           End If
       Next j
     Next i
      .Range("B1:AA" & lr).Value = arr
End With
End Sub

HI anh, Cảm ơn anh, kết quả đúng rồi anh.
View attachment 211497

snow25 · 23/1/19

vulunktheky đã viết:
HI anh, nếu em thêm những size màu vàng thì sữa code như thế nào vậy anh?
View attachment 211497

Không thấy gì bạn gửi luôn ở đây không được à.

vulunktheky · 23/1/19

snow25 đã viết:
Không thấy gì bạn gửi luôn ở đây không được à.

E bị nhằm á anh. Kết quả đúng rồi anh. E cảm ơn.

Tìm kiếm theo nhiều điều kiện (5 người xem)

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

vulunktheky

Thành viên thường trực

File đính kèm

snow25

Thành viên gạo cội

vulunktheky

Thành viên thường trực

snow25

Thành viên gạo cội

vulunktheky

Thành viên thường trực

snow25

Thành viên gạo cội

snow25

Thành viên gạo cội

File đính kèm

vulunktheky

Thành viên thường trực

vulunktheky

Thành viên thường trực

snow25

Thành viên gạo cội

vulunktheky

Thành viên thường trực

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

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