Yazının otomatik gelmesi

[reisserkan]

Merhaba

Ekte bulunan stok dosyasında, "GÜNCEL STOK, GİRİŞ VE ÇIKIŞ" şeklinde yapılmıştır. Güncel stok kısmında yer alan stok isminin stok girişe ve çıkışa stok kodunu yazdığımda
otomatik gelmesini istiyorum ama yapamadım. ekteki dosyada örneğe göre düzenlemesini yapabilirmisiniz. Teşekkürler

https://dosya.co/bhrg6if88jle/STOKÖRNEK.rar.html

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu Excel Kod bölümünde bulunan ThisWorkbook(BuÇalışmaKiştabı) adlı kod sayfasına kopyalayın.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Bul As String
    If Not Sh.Name = "STOK GİRİŞ" Or Not Sh.Name = "STOK GİRİŞ" Then Exit Sub
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    On Error Resume Next
    Bul = Worksheets("GÜNCEL STOK").Range("A:A").Find(Target.Text).Offset(0, 1)
    If Bul = Empty Then Bul = "Ürün Kodu Bulunamadı"
    Target(1, 2) = Bul
    Application.EnableEvents = True
End Sub

 

[yanginci34]

Denermisiniz.
https://dosya.co/0lssos3kt1p7/STOKÖRNEK.xls.html

 

[reisserkan]

abi Allah razı olsun, muazzam olmuş eline sağlık.

 

[yanginci34]

Rica ederim Allah hepimizden razı olsun. Kolay gelsin.

 

[reisserkan]

giriş ve çıkışdan satır sildiğimde aşağıdaki hata mesajını alıyorum. debug yada end dediğimdi makro sayfası açılıyor. Bu normalmi Teşekkürler
Microsof visual Basic
Run-time error '13':
Type missmatch

 

[yanginci34]

Sayfaların kod bölümlerine son tanımından sonra aşağıdaki kodu ekleyip denermisiniz.
On Error Resume Next

 

[reisserkan]

aynı hatayı girişe bir yada birden fazla satır eklediğimde de alıyorum. Çözümü varmıdır. Teşekkürler

 

[yanginci34]

Buyrun eklenmiş hali.
https://dosya.co/2s0bx56ul7wu/STOKÖRNEK.xls.html

 

[reisserkan]

bu sayfa açıldı sarı okla gösterildi "If Target = "" Then"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim son
Dim i
son = Sheets("GÜNCEL STOK").Cells(Rows.Count, 1).End(3).Row

If Intersect(Target, [a2:a65536]) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 2) = ""
Exit Sub
End If
If WorksheetFunction.CountIf(Sheets("GÜNCEL STOK").Range("A2:A" & son), (Target)) = 0 Then
MsgBox "Yazdığınız STOK KODU nu kontrol ediniz!!", vbCritical, "ARADIĞINIZ STOK KODU BULUNAMADI"
Exit Sub
Else

For i = 2 To son
If Target = Sheets("GÜNCEL STOK").Cells(i, 1) Then
Target.Offset(0, 1) = Sheets("GÜNCEL STOK").Cells(i, 2)
Target.Offset(0, 2) = Sheets("GÜNCEL STOK").Cells(i, 3)
'Else
'MsgBox "Yazdığınız STOK KODU nu kontrol ediniz!!", vbCritical, "ARADIĞINIZ STOK KODU BULUNAMADI"
'EXİT SUB
End If
Next
End If

End Sub

 

[reisserkan]

Sayende oldu çok sağol. Kolay gelsin, iyi çalışmalar

 

[yanginci34]

Kırmızı olan yeri ekleyin. her iki sayfanında kod bölümüne.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim son
Dim i
son = Sheets("GÜNCEL STOK").Cells(Rows.Count, 1).End(3).Row
On Error Resume Next
If Intersect(Target, [a2:a65536]) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 2) = ""
Exit Sub
End If
If WorksheetFunction.CountIf(Sheets("GÜNCEL STOK").Range("A2:A" & son), (Target)) = 0 Then
MsgBox "Yazdığınız STOK KODU nu kontrol ediniz!!", vbCritical, "ARADIĞINIZ STOK KODU BULUNAMADI"
Exit Sub
Else

For i = 2 To son
If Target = Sheets("GÜNCEL STOK").Cells(i, 1) Then
Target.Offset(0, 1) = Sheets("GÜNCEL STOK").Cells(i, 2)
Target.Offset(0, 2) = Sheets("GÜNCEL STOK").Cells(i, 3)
'Else
'MsgBox "Yazdığınız STOK KODU nu kontrol ediniz!!", vbCritical, "ARADIĞINIZ STOK KODU BULUNAMADI"
'EXİT SUB
End If
Next
End If

End Sub

 

[yanginci34]

Rica ederim kolay gelsin