Ara Bul Getir

Katılım
24 Nisan 2011
Mesajlar
18
Excel Vers. ve Dili
EXCEL 2003
Arkadaşlarım iyi çalışmalar. EXCEL de hazırlamış olduğum bir listem var. yüzeysel olarak tablo hazırladım. hazırladığım tabloda test ve veri olarak 2 adet sayfa bulunmaktadır. veri sayfasında A sütünün da STOK numaraları bulunmakta ve bu stok numaraları 12 rakamdan oluşmakta. test sayfasında A2 hücresine stok numaralarının herhangi birinin son 4 rakamını yazdığımda B2 hücresine yazmak istediğim stok numarasının tamamını yazmasını istiyorum. Bana bu konuda yardımcı olursanız sevinirim.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,374
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Paylaşım sitelerinden birine örnek bir dosya ekleyiniz, yardımcı olacak arkadaşlar çıkacaktır.
 
Katılım
24 Nisan 2011
Mesajlar
18
Excel Vers. ve Dili
EXCEL 2003
Arkadaşlarım iyi çalışmalar. EXCEL de hazırlamış olduğum bir listem var. yüzeysel olarak tablo hazırladım. hazırladığım tabloda test ve veri olarak 2 adet sayfa bulunmaktadır. veri sayfasında A sütünün da STOK numaraları bulunmakta ve bu stok numaraları 12 rakamdan oluşmakta. test sayfasında A2 hücresine stok numaralarının herhangi birinin son 4 rakamını yazdığımda B2 hücresine yazmak istediğim stok numarasının tamamını yazmasını istiyorum. Bana bu konuda yardımcı olursanız sevinirim.
Örnek Dosyamı buraya yükledim
https://drive.google.com/open?id=1S4WsiHGUly0_RAo63S9Q_JIUmqDgqgh6
 
Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
Deneyiniz.
Kod:
=İNDİS(veri!$A$2:$A$2000;KAÇINCI("*"&test!$A$2;veri!$A$2:$A$2000;0))
 
Katılım
24 Nisan 2011
Mesajlar
18
Excel Vers. ve Dili
EXCEL 2003
Deneyiniz.
Kod:
=İNDİS(veri!$A$2:$A$2000;KAÇINCI("*"&test!$A$2;veri!$A$2:$A$2000;0))
Çok Teşekkür ederim Elinize sağlık. Peki bu olayı test sayfasında ki direk A2 hücresine stok no son 4 harfini direk oraya yazıp enter dediğimde stok numarasının hepsi aynı hücrede görüntüleyebilir miyiz.
 
Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
test sayfa kodu olarak kopyalayınız.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, [A2]) Is Nothing Then Exit Sub
Dim s2 As Worksheet:Dim i as Integer
Set wf = WorksheetFunction: Set s2 = Sheets("veri")
son = s2.Cells(65355, "A").End(3).Row
Range("A2").NumberFormat = "@"
a = Len(Target.Value)
If a <> 4 And a <> 12 Then
MsgBox "4 haneli sayı giriniz."
Exit Sub
End If
b = wf.CountIf(s2.Range("A2:A" & son), "*" & Target.Value)
If b = 0 Then
MsgBox "Aranan değer bulunamadı"
Exit Sub
End If
For i = 2 To son + 1
bak = s2.Range("A" & i)
dg = Right(bak, 4)
If Target.Value = dg And Len(bak) = 12 Then
Target.Value = s2.Range("A" & i)
GoTo çık
End If
Next i
çık:
End Sub
 
Katılım
24 Nisan 2011
Mesajlar
18
Excel Vers. ve Dili
EXCEL 2003
test sayfa kodu olarak kopyalayınız.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, [A2]) Is Nothing Then Exit Sub
Dim s2 As Worksheet:Dim i as Integer
Set wf = WorksheetFunction: Set s2 = Sheets("veri")
son = s2.Cells(65355, "A").End(3).Row
Range("A2").NumberFormat = "@"
a = Len(Target.Value)
If a <> 4 And a <> 12 Then
MsgBox "4 haneli sayı giriniz."
Exit Sub
End If
b = wf.CountIf(s2.Range("A2:A" & son), "*" & Target.Value)
If b = 0 Then
MsgBox "Aranan değer bulunamadı"
Exit Sub
End If
For i = 2 To son + 1
bak = s2.Range("A" & i)
dg = Right(bak, 4)
If Target.Value = dg And Len(bak) = 12 Then
Target.Value = s2.Range("A" & i)
GoTo çık
End If
Next i
çık:
End Sub
Test sayfa kodu olarak nasıl kayıt yapacağım anlamadım kusura bakmayın
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,306
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
TEST isimli sayfanızın ismi üzerinde sağ tıklayın ve KOD GÖRÜNTÜLE seçeneğini seçin. Açılan pencereye önerilen kodu uygulayın. Excel dosyanızı da MAKRO İÇEREN dosya formatında (.xlsm uzantısıyla) kayıt edin. Sonra kullanmaya başlayabilirsiniz.

Alternatif kod;

Kod:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Stok_No As Range
    If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Len(Target.Value) = 4 Then
        Set Stok_No = Sheets("veri").Range("A:A").Find("*" & Target.Value)
        If Not Stok_No Is Nothing Then
            Target.Value = Stok_No.Value
        Else
            MsgBox "Stok numarası bulunamadı!", vbCritical
            Target.Select
        End If
    End If
End Sub
 
Katılım
26 Temmuz 2005
Mesajlar
11
TEST isimli sayfanızın ismi üzerinde sağ tıklayın ve KOD GÖRÜNTÜLE seçeneğini seçin. Açılan pencereye önerilen kodu uygulayın. Excel dosyanızı da MAKRO İÇEREN dosya formatında (.xlsm uzantısıyla) kayıt edin. Sonra kullanmaya başlayabilirsiniz.

Alternatif kod;

Kod:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Stok_No As Range
If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Len(Target.Value) = 4 Then
Set Stok_No = Sheets("veri").Range("A:A").Find("*" & Target.Value)
If Not Stok_No Is Nothing Then
Target.Value = Stok_No.Value
Else
MsgBox "Stok numarası bulunamadı!", vbCritical
Target.Select
End If
End If
End Sub
Teşekkür ederim dediğiniz gibi yaptım fakat çalışmadı. Ama sorun yok olsa çok çok iyi olurdu ama diğeri de işimi gördü çok saolun


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 
Katılım
26 Temmuz 2005
Mesajlar
11
Çok teşekkür ederim işimi fazlasıyla gördü. Elinize sağlık


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 
Katılım
26 Temmuz 2005
Mesajlar
11
Deneyiniz.
Kod:
=İNDİS(veri!$A$2:$A$2000;KAÇINCI("*"&test!$A$2;veri!$A$2:$A$2000;0))
Merhabalar tekrar ben kusura bakmayın . Verdiğiniz formülü iş yerinde uyguladım çalışıyor. Fakat A2 hücresini boş bıraktığımda yani hiç bir şey yazmadığımda eski yazdığım durmakta. Boş olduğunda ise hücre boş görünsün yapabilir miyiz


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 
Üst