Bài toán tìm kiếm với nhiều điều kiện. (1 người xem)

[bogay]

Mong các pro giải hộ em bài toán này nhé. Em xin cám ơn!

 

[ChanhTQ@]

Bạn xem trong file đính kèm, dùng macro

Fím nóng: {CTRL}+{SHIFT}+T

 

[bogay]

Em không sành về Macro. Có hàm tính toán cụ thể không hả các Pro?

 

[vanle33]

Fím nóng: {CTRL}+{SHIFT}+T

Bài của bác ra kết quả thiếu rồi
1) Tại mã hiệu AF.12114 ngoài ra khối lượng đá 1x2 còn có Cát vàng và Xi măng PC30 và 1 loạt các vật tư nữa ....
Bác chỉnh lại Code nhé

 

[vanle33]

Em không sành về Macro. Có hàm tính toán cụ thể không hả các Pro?

Bạn kiểm tra lại bài của bác ChanhTQ đã đúng với ý bạn chưa?
Ý bạn có phải muốn tìm tất cả các loại vật liệu tương ứng với mã hiệu và điền sang bảng PTVT?

 

[ChanhTQ@]

/-)úng là còn thiếu nhiều; Xin cảm ơn bạn

Bài của bác ra kết quả thiếu rồi
1) Tại mã hiệu AF.12114 ngoài ra khối lượng đá 1x2 còn có Cát vàng và Xi măng PC30 và 1 loạt các vật tư nữa ....
Bác chỉnh lại Code nhé

Code cần bỏ bớt các dòng lệnh thừa, như sau:

Option Explicit
Sub gpeTim()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Rg0 As Range, Cll As Range
 Dim Rws As Long, jJ As Long, Tht As Boolean
 
 Sheets("PTVT").Select
 Set Sh = ThisWorkbook.Worksheets("DGCT")
 Rws = Sh.[d65500].End(xlUp).Row
 Set Rng = Sh.Range("B5:B" & Rws)
 jJ = [B65500].End(xlUp).Row
 [F7].Resize(jJ - 6, 15).ClearContents
 Randomize
 [f5].Resize(, 10).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
 For Each Cls In Range([B7], [B7].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set Rg0 = Sh.Range(sRng, sRng.End(xlDown).Offset(-1)).Offset(, 2)
        If Rg0.Rows.Count > Rws Then _
            Set Rg0 = sRng.Resize(Rws - sRng.Row + 1).Offset(, 2)
        For jJ = 6 To 15
            For Each Cll In Rg0
                If Cll.Value = Cells(5, jJ).Value Then
                    Cells(Cls.Row, jJ).Value = Cll.Offset(, 3).Value
                    'Tht = True     <=|'
                    Exit For
                End If
            Next Cll
'            If Tht Then'
'                Tht = False:            Exit For'
'            End If'
        Next jJ
    End If
 Next Cls
End Sub

 

[bogay]

Mình chỉ muốn tìm những vật tư bên bảng PTVT thôi. Còn các loại vật tư khác thì bỏ qua.

 

[tvl297]

Bạn xem biểu này đã được chưa, không biết có đúng ý bạn không

 

[bogay]

Bạn xem biểu này đã được chưa, không biết có đúng ý bạn không

Chuẩn không cần chỉnh. Cám ơn bác.

 

[bogay]

Code cần bỏ bớt các dòng lệnh thừa, như sau:

Option Explicit
Sub gpeTim()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Rg0 As Range, Cll As Range
 Dim Rws As Long, jJ As Long, Tht As Boolean
 
 Sheets("PTVT").Select
 Set Sh = ThisWorkbook.Worksheets("DGCT")
 Rws = Sh.[d65500].End(xlUp).Row
 Set Rng = Sh.Range("B5:B" & Rws)
 jJ = [B65500].End(xlUp).Row
 [F7].Resize(jJ - 6, 15).ClearContents
 Randomize
 [f5].Resize(, 10).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
 For Each Cls In Range([B7], [B7].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set Rg0 = Sh.Range(sRng, sRng.End(xlDown).Offset(-1)).Offset(, 2)
        If Rg0.Rows.Count > Rws Then _
            Set Rg0 = sRng.Resize(Rws - sRng.Row + 1).Offset(, 2)
        For jJ = 6 To 15
            For Each Cll In Rg0
                If Cll.Value = Cells(5, jJ).Value Then
                    Cells(Cls.Row, jJ).Value = Cll.Offset(, 3).Value
                    'Tht = True     <=|'
                    Exit For
                End If
            Next Cll
'            If Tht Then'
'                Tht = False:            Exit For'
'            End If'
        Next jJ
    End If
 Next Cls
End Sub

Bạn ơi có thể thêm Code tạo liên kết không bạn? Mình xin cám ơn.

 

[phanngoctuan]

cần giúp đỡ tại đây http://www.giaiphapexcel.com/forum/showthread.php?72507-Tìm-kiếm-2-chiều-trong-excel&p=443392