XIN GIÚP ĐỠ TÌM DỮ LIỆU THEO ĐIỀU KIỆN (4 người xem)

hoanganh00 · 6/3/19

Xin chào các anh chị, mình có 1 vướn mắc mong được anh chị hướng dẫn.
mình có 2 bảng như bên dưới, muốn tìm giá trị của cột C1 bảng 1 từ cột C của bảng 2. Giá trị so sánh là khớp giá trị cột A, B của bảng 1 với cột B, A của bảng 2 (mình để thứ tự hơi sai). và 1 điều kiện nữa là giá trị nhận được phải khác nhau. Ví dụ như sau khi nhận được giá trị thì C1=DRYU3048058 thì C2 phải bằng giá trị trùng tiếp theo như là DRYU3044181...

Rất mong nhận được sự giúp đỡ của các anh chị.
Cảm ơn nhiều ạ.

snow25 · 6/3/19

hoanganh00 đã viết:
Xin chào các anh chị, mình có 1 vướn mắc mong được anh chị hướng dẫn.
mình có 2 bảng như bên dưới, muốn tìm giá trị của cột C1 bảng 1 từ cột C của bảng 2. Giá trị so sánh là khớp giá trị cột A, B của bảng 1 với cột B, A của bảng 2 (mình để thứ tự hơi sai). và 1 điều kiện nữa là giá trị nhận được phải khác nhau. Ví dụ như sau khi nhận được giá trị thì C1=DRYU3048058 thì C2 phải bằng giá trị trùng tiếp theo như là DRYU3044181...

Rất mong nhận được sự giúp đỡ của các anh chị.
Cảm ơn nhiều ạ.

View attachment 213231

Thế bạn không gửi File lên thì giúp kiểu gì.Dùng VBA bạn nhé.

VuVanHao · 6/3/19

hoanganh00 đã viết:
Xin chào các anh chị, mình có 1 vướn mắc mong được anh chị hướng dẫn.
mình có 2 bảng như bên dưới, muốn tìm giá trị của cột C1 bảng 1 từ cột C của bảng 2. Giá trị so sánh là khớp giá trị cột A, B của bảng 1 với cột B, A của bảng 2 (mình để thứ tự hơi sai). và 1 điều kiện nữa là giá trị nhận được phải khác nhau. Ví dụ như sau khi nhận được giá trị thì C1=DRYU3048058 thì C2 phải bằng giá trị trùng tiếp theo như là DRYU3044181...

Rất mong nhận được sự giúp đỡ của các anh chị.
Cảm ơn nhiều ạ.

View attachment 213231

Bạn gửi file mẫu lên xem thế nào

hoanganh00 · 6/3/19

Mình gởi bạn file mẫu nhé.

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

hao93tbdtn đã viết:
Bạn gửi file mẫu lên xem thế nào

Gởi bạn file mẫu

snow25 · 6/3/19

hoanganh00 đã viết:
Mình gởi bạn file mẫu nhé.

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

Gởi bạn file mẫu

Bạn chạy code này xem đúng không nhé.

Mã:

Sub laydulieu()
    Dim arr, dic As Object, i As Long, a As Integer, s As String, dk As String, T
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
         arr = .Range("J5:L27").Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(arr(i, 3), 0)
             Else
                dic.Item(dk) = Array(dic.Item(dk)(0) & "#" & arr(i, 3), 0)
             End If
        Next i
        .Range("F5:F32").ClearContents
        arr = .Range("D5:F32").Value
        For i = 1 To UBound(arr, 1)
             dk = arr(i, 2) & "#" & arr(i, 1)
             If dic.exists(dk) Then
                a = dic.Item(dk)(1)
                T = Split(dic.Item(dk)(0), "#")
                If a > UBound(T) Then a = 0
                arr(i, 3) = T(a)
                dic.Item(dk) = Array(dic.Item(dk)(0), a + 1)
             End If
        Next i
        .Range("D5:F32").Value = arr
   End With
End Sub

VuVanHao · 6/3/19

hoanganh00 đã viết:
Mình gởi bạn file mẫu nhé.

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

Gởi bạn file mẫu[/Q
Mình chỉ có cách thêm cột phụ như file dưới thôi

hoanganh00 · 6/3/19

snow25 đã viết:

Bạn chạy code này xem đúng không nhé.

Mã:

Sub laydulieu()
    Dim arr, dic As Object, i As Long, a As Integer, s As String, dk As String, T
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
         arr = .Range("J5:L27").Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(arr(i, 3), 0)
             Else
                dic.Item(dk) = Array(dic.Item(dk)(0) & "#" & arr(i, 3), 0)
             End If
        Next i
        .Range("F5:F32").ClearContents
        arr = .Range("D5:F32").Value
        For i = 1 To UBound(arr, 1)
             dk = arr(i, 2) & "#" & arr(i, 1)
             If dic.exists(dk) Then
                a = dic.Item(dk)(1)
                T = Split(dic.Item(dk)(0), "#")
                If a > UBound(T) Then a = 0
                arr(i, 3) = T(a)
                dic.Item(dk) = Array(dic.Item(dk)(0), a + 1)
             End If
        Next i
        .Range("D5:F32").Value = arr
   End With
End Sub

Cảm ơn bạn nhiều, mình mù VBA, bạn có thể hướng dẫn dúng đoạn mã này như thế nào.
Với lại kết quả nó bị trùng, mình mong muốn là kết quả có đc chỉ lấy 1 lần. Bạn giúp minh nhé.

snow25 · 6/3/19

hoanganh00 đã viết:
Cảm ơn bạn nhiều, mình mù VBA, bạn có thể hướng dẫn dúng đoạn mã này như thế nào.
Với lại kết quả nó bị trùng, mình mong muốn là kết quả có đc chỉ lấy 1 lần. Bạn giúp minh nhé.

Thế thằng đằng sau nó có nữa thì làm thế nào.Không nhận nữa chứ.Mà bạn đưa file mẫu giống file của bạn lên mình chỉnh lại code luôn.Hướng dẫn thì mình cũng không biết à.

hoanganh00 · 6/3/19

mình gởi lại bạn file của mình.
trong file này mình cần giá trị điền vào cột B sheet RELASE, lấy dữ liệu từ sheet2 dùng giá trị so sánh cột C, P sheet RELASE với cột B, L sheet2, lấy giá trị ở cột A sheet2.
Hiểu nôm na là, thằng cột P nó đi chọn vợ bên sheet2, nó thấy đứa nào có cột L giống nó và khớp với cột C, B thì nó lấy về, có thằng khác cũng như nó cũng đi tìm vợ và cũng tìm đc đứa khác đáp ứng đc yêu cầu và rước về. Nhưng nhiều đứa đi tìm vợ mà gái có hạn nên đứa nào đến sau đó thì ko tìm đc, phải ở không. Vậy đó

snow25 · 6/3/19

hoanganh00 đã viết:
mình gởi lại bạn file của mình.
trong file này mình cần giá trị điền vào cột B sheet RELASE, lấy dữ liệu từ sheet2 dùng giá trị so sánh cột C, P sheet RELASE với cột B, L sheet2, lấy giá trị ở cột A sheet2.
Hiểu nôm na là, thằng cột P nó đi chọn vợ bên sheet2, nó thấy đứa nào có cột L giống nó và khớp với cột C, B thì nó lấy về, có thằng khác cũng như nó cũng đi tìm vợ và cũng tìm đc đứa khác đáp ứng đc yêu cầu và rước về. Nhưng nhiều đứa đi tìm vợ mà gái có hạn nên đứa nào đến sau đó thì ko tìm đc, phải ở không. Vậy đó

Đây nhé bạn.Chỉ cần bấm vào nút lấy dữ liệu là được.

Mã:

Sub laydulieu()
    Dim arr, dic As Object, i As Long, a As Integer, s As String, dk As String, T, Lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
         Lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("a2:L" & Lr).Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 2) & "#" & arr(i, 12)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(arr(i, 1), 0)
             Else
                dic.Item(dk) = Array(dic.Item(dk)(0) & "#" & arr(i, 1), 0)
             End If
        Next i
    End With
    With Sheets("RELASE")
         Lr = .Range("C" & Rows.Count).End(xlUp).Row
         If Lr < 8 Then Exit Sub
        .Range("b8:b" & Lr).ClearContents
        arr = .Range("C8:P" & Lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 1)
        For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 14)
             If dic.exists(dk) Then
                a = dic.Item(dk)(1)
                T = Split(dic.Item(dk)(0), "#")
                If a <= UBound(T) Then
                    arr1(i, 1) = T(a)
                    dic.Item(dk) = Array(dic.Item(dk)(0), a + 1)
                End If
             End If
        Next i
        .Range("B8").Resize(i - 1, 1).Value = arr1
   End With
End Sub

hoanganh00 · 6/3/19

snow25 đã viết:

Đây nhé bạn.Chỉ cần bấm vào nút lấy dữ liệu là được.

Mã:

Sub laydulieu()
    Dim arr, dic As Object, i As Long, a As Integer, s As String, dk As String, T, Lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
         Lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("a2:L" & Lr).Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 2) & "#" & arr(i, 12)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(arr(i, 1), 0)
             Else
                dic.Item(dk) = Array(dic.Item(dk)(0) & "#" & arr(i, 1), 0)
             End If
        Next i
    End With
    With Sheets("RELASE")
         Lr = .Range("C" & Rows.Count).End(xlUp).Row
         If Lr < 8 Then Exit Sub
        .Range("b8:b" & Lr).ClearContents
        arr = .Range("C8:P" & Lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 1)
        For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 14)
             If dic.exists(dk) Then
                a = dic.Item(dk)(1)
                T = Split(dic.Item(dk)(0), "#")
                If a <= UBound(T) Then
                    arr1(i, 1) = T(a)
                    dic.Item(dk) = Array(dic.Item(dk)(0), a + 1)
                End If
             End If
        Next i
        .Range("B8").Resize(i - 1, 1).Value = arr1
   End With
End Sub

[/QUOTE

Bạn cho mình hỏi nút laydulieu ở đâu vậy, trong file không có, cảm ơn nhiều nhé.

snow25 · 7/3/19

Mình up lại file bạn xem lại nhé.

hoanganh00 · 7/3/19

cảm ơn bạn nhé.

XIN GIÚP ĐỠ TÌM DỮ LIỆU THEO ĐIỀU KIỆN (4 người xem)

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

hoanganh00

Thành viên mới

File đính kèm

snow25

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

VuVanHao

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

hoanganh00

Thành viên mới

File đính kèm

snow25

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

File đính kèm

VuVanHao

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

File đính kèm

hoanganh00

Thành viên mới

snow25

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

hoanganh00

Thành viên mới

File đính kèm

snow25

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

File đính kèm

hoanganh00

Thành viên mới

snow25

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

hoanganh00

Thành viên mới

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