Oto Yedek Parça Numarasına Göre Parça Adının Yazdırılması

[ybilgin]

Arkadaşlar hepinize selamlar,
Uzun zamandır siteye bağlanamıyorum,
VBA konusunda bilgi sahibi arkadaşların yardımına ihtiyacım var,
Ekte sunduğum örnek dosyada yedek parçaların numara ve parça
isimlerinin bulunduğu bir sayfa var.
Başka bir sayfanın, A2 hücresine parça numarasını yazacağım, bu parçanın ismi B2 hücresine otomatik yazdırılabilirmi.
100 satır 200 satır yapılabilmeli.

hepinize teşekkürler.

 

[Orion1]

Dosyanız hazır .
Ekli dosyayı inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Range, s2 As Worksheet
If Intersect(Target, [A2:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
If Target.Value = "" Then
    Range(Cells(Target.Row, 1), Cells(Target.Row, 2)).Value = ""
    GoTo son
End If
Set s2 = Sheets("parça")
If Target.Column = 1 Then
    Set k = s2.Range("A2:A65536").Find(Target.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(Target.Row, 2).Value = s2.Cells(k.Row, 2).Value
    End If
End If
If Target.Column = 2 Then
    Set k = s2.Range("B2:B65536").Find(Target.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(Target.Row, 1).Value = s2.Cells(k.Row, 1).Value
    End If
End If
son:
Application.EnableEvents = True
Set k = Nothing
Set s2 = Nothing
End Sub

 

[N.Ziya Hiçdurmaz]

Yanıt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SUT As Long
Dim S1 As Worksheet
If Intersect(Target, [A2:B100]) Is Nothing Then Exit Sub
On Error GoTo HATA
Set S1 = Sheets("parça")
For SUT = 1 To S1.Cells(65536, "A").End(3).Row
If Target = S1.Cells(SUT, "A") And Target.Offset(0, 1) = "" Then
Target.Offset(0, 1) = S1.Cells(SUT, "A").Offset(0, 1)
End If
Next
For SUT = 1 To S1.Cells(65536, "A").End(3).Row
If Target = S1.Cells(SUT, "B") And Target.Offset(0, -1) = "" Then
Target.Offset(0, -1) = S1.Cells(SUT, "B").Offset(0, -1)
End If
Next
HATA:
End Sub

 

[ybilgin]

Sayın Evren gizlen
yardımlarınız için çook teşekkür ederim.
tek kelimeyle mükemmel olmuş.
böyle olacağını hiç tahmin etmezdim.
Şimdi sizlerin neler başarabildiğinizi görünce
heyecanlandım, acaba bir adım daha öteye gidebilirmiyiz diye kendi kendime sordum.

parça numarasını yazarken, aynı combo box taki gibi, 32745652 yazarken serilerin hücrede gözükmesi de sağlanabilirmi acaba, yazdığım rakama en yakın olan onunla eşleşen ekranda çıkabilirmi. galiba tam anlatamadım.
yani combo box taki gibi, aşağı açılmayacakta sadece hücrede gözükecek.

bu bile çok fazlasıyla işimi görecek,
yardımlarınız için teşekkür ederim.

sayın n.ziya hiçdurmaz beyede teşekkür ediyorum.

 

[Orion1]

Sayın Evren gizlen
yardımlarınız için çook teşekkür ederim.
tek kelimeyle mükemmel olmuş.
böyle olacağını hiç tahmin etmezdim.
Şimdi sizlerin neler başarabildiğinizi görünce
heyecanlandım, acaba bir adım daha öteye gidebilirmiyiz diye kendi kendime sordum.

parça numarasını yazarken, aynı combo box taki gibi, 32745652 yazarken serilerin hücrede gözükmesi de sağlanabilirmi acaba, yazdığım rakama en yakın olan onunla eşleşen ekranda çıkabilirmi. galiba tam anlatamadım.
yani combo box taki gibi, aşağı açılmayacakta sadece hücrede gözükecek.

bu bile çok fazlasıyla işimi görecek,
yardımlarınız için teşekkür ederim.

sayın n.ziya hiçdurmaz beyede teşekkür ediyorum.

Ekli dosyayı inceleyiniz.

 

[ybilgin]

ellerinize sağlık nekadar teşekkür etsem azdır.
tam anlamıyla size minnettar kaldım.
elleriniz dert görmesin. hayırlı çalışmalar

 

[Orion1]

ellerinize sağlık nekadar teşekkür etsem azdır.
tam anlamıyla size minnettar kaldım.
elleriniz dert görmesin. hayırlı çalışmalar

Rica ederim.
iyi günlerde kullananın.
İyi çalışmalar.

 

[bal.b]

Merhaba,
bu dosyayı daha önce indirmiştim ve çok faydalıydı.Pc çöktü şu anda dosyayı bulamıyorum bu dosyayı gönderebilirmisin?

 

[Orion1]

Merhaba,
bu dosyayı daha önce indirmiştim ve çok faydalıydı.Pc çöktü şu anda dosyayı bulamıyorum bu dosyayı gönderebilirmisin?

Dosya bende yok.Sayın ybilginden isteyiniz.

 

[ybilgin]

merhaba,
dosya işyerindeki pc de. yarın sabah erkenden eklerim,
kolay gelsin.

 

[ybilgin]

sayın bal.b
istediğiniz dosya ektedir
sayfa korumalarının parolaları www.excel.web.tr dir.
iyi çalışmalar.