Kodlarda düzeltilmesi hk.

[1903emre34@gmail.com]

Merhaba,

Ana kod 180,600 yazdığım zaman fiş numarası 441 olan kayıt gelmektedir, ben gelmesini istemiyorum, fişi numarası 443 olan gelmesini istiyorum, çünkü 180,600 hangi fişi numarasında varsa geliyor, kodlarda nasıl düzeltme yapabiliriz.

 

[veyselemre]

Sub istenenKodlarGecenSonFisiBul()
    Set m = Sheets("MUAVİN")
    Set a = Sheets("ARAMA")
    kodlar = WorksheetFunction.Trim(Join(Application.Transpose(a.Range("B2:B8").Value)))
    son = m.Cells(Rows.Count, 1).End(3).Row
    With CreateObject("Scripting.Dictionary")
        For i = son To 2 Step -1
            fNo = Trim(m.Cells(i, "E").Value)
            If Not .exists(fNo) Then
                v = Trim(m.Cells(i, "A").Value)
            Else
                v = .Item(fNo)
                v = v & " " & Trim(m.Cells(i, "A").Value)
            End If
            .Item(fNo) = v
        Next i
        For Each ara In Split(kodlar, " ")
            kys = .keys
            itms = .Items
            For i = UBound(itms) To 0 Step -1
                If InStr(itms(i), ara) = 0 Then
                    .Remove kys(i)
                End If
            Next i
        Next ara

        kys = .keys
        If UBound(kys) > -1 Then
            a.Range("B11:I100").Delete
            sat = 11
            For i = 2 To son
                If Trim(m.Cells(i, "E")) = kys(0) Then
                    m.Cells(i, "A").Resize(, 8).Copy a.Cells(sat, "B")
                    sat = sat + 1
                End If
            Next i
        Else
            MsgBox "Uygun Fiş Bulunamadı..."
        End If
    End With

End Sub