• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Eğer komutuyla yapılırmı

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
V

van_65166

Katılım
9 Kasım 2012
Mesajlar
92
Excel Vers. ve Dili
offis 7 türkce
Merhaba;


Excel kitabımda Sayfa 1 de ürün listem var, a1 hücresi ürün kodu b1 hücresi ürün adı c1 hücresi koli içi adeti

sayfa 2 ye c7 ye ürün kodunu yazdığım zaman düşey ara formülü ile ürün adını ve koli içi adetini d7 ve e7 ye getirtiyorum

fakat sayfa birde kayıt olmayan bir ürünü mümkün mertebe bulamıyor sizden istediğim c7 ye ürün kodunu yazdığım zaman ürün yoksa bir uyarı ekranı çıksın ürün kaydedilsinmi diye eğer evet ise sayfa birdeki ürünlerin altına InputBox a girilmiş değeri yazsın inşallah anlata bilmişimdir.

iyi çalışmalar dilerim.
 
Merhaba,

Benzer bir konuyu daha önce açmışsınız,altın üye olduğunuzu da görüyorum.

Örnek dosya ekleyebilir misiniz.
 
referans ekleme

kuvari' Alıntı:
Merhaba,

Benzer bir konuyu daha önce açmışsınız,altın üye olduğunuzu da görüyorum.

Örnek dosya ekleyebilir misiniz.
Genişletmek için tıkla ...

Dosyayı ekledim.

O konuyu düşeyara formülüyle ilgili açtım ama bu hata çıktı bu sefer aynı dosya fakat farklı hata.
 

Ekli dosyalar

Sayfa2'nin kod bölümüne aşağıdaki kodları yapıştırıp dener misiniz:

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a10000"), [c7]) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    
    [f1] = a
    Sheets("sayfa1").Cells(a, 1) = Target
    Sheets("sayfa1").Cells(a, 2) = InputBox(Target & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Target & " kodlu ürün için koli içi adet giriniz:")
    Sheets("sayfa2").[d7] = Sheets("sayfa1").Cells(a, 2)
    Sheets("sayfa2").[e7] = Sheets("sayfa1").Cells(a, 3)
    End If
Else
Sheets("sayfa2").[d7] = WorksheetFunction.VLookup([c7], Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Sheets("sayfa2").[e7] = WorksheetFunction.VLookup([c7], Sheets("sayfa1").Range("A2:c" & a), 3, 0)
End If
Target.Select
End Sub
 
Eklediğiniz dosyayı sonradan gördüm. Kodları dosyanıza göre revize ettim. Yalnız sayfa1'de kodları formülle yazmasanız daha iyi olur:

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7:c100")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a" & a), Target) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    Sheets("sayfa1").Cells(a, 1) = Target
    Sheets("sayfa1").Cells(a, 2) = InputBox(Target & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Target & " kodlu ürün için koli içi adet giriniz:")
    Target.Offset(0, 1) = Sheets("sayfa1").Cells(a, 2)
    Target.Offset(0, 2) = Sheets("sayfa1").Cells(a, 3)
    End If
Else
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 3, 0)
End If
Target.Offset(0,3).Select

End Sub
 
Kodu biraz daha değiştirdim. Aşağıdaki kodlar, girdiğiniz kod sayfa1'de yoksa eğer isterseniz sıradaki ilk boş kodu ekleme işlemini yapar:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7:c100")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a" & a), Target) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, sıradaki ürün koduyla eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    Sheets("sayfa1").Cells(a, 1) = Sheets("sayfa1").Cells(a - 1, 1) + 1
    Sheets("sayfa1").Cells(a, 2) = InputBox(Sheets("sayfa1").Cells(a - 1, 1) + 1 & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Sheets("sayfa1").Cells(a - 1, 1) + 1 & " kodlu ürün için koli içi adet giriniz:")
    Target = Sheets("sayfa1").Cells(a - 1, 1) + 1
    Target.Offset(0, 1) = Sheets("sayfa1").Cells(a, 2)
    Target.Offset(0, 2) = Sheets("sayfa1").Cells(a, 3)
    Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
Else
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 3, 0)
Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
End If
Target.Offset(0, 3).Select

End Sub
 
Son düzenleme:
YUSUF44' Alıntı:
Kodu biraz daha değiştirdim. Aşağıdaki kodlar, girdiğiniz kod sayfa1'de yoksa eğer isterseniz sıradaki ilk boş kodu ekleme işlemini yapar:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7:c100")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a" & a), Target) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, sıradaki ürün koduyla eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    Sheets("sayfa1").Cells(a, 1) = Sheets("sayfa1").Cells(a - 1, 1) + 1
    Sheets("sayfa1").Cells(a, 2) = InputBox(Sheets("sayfa1").Cells(a - 1, 1) + 1 & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Sheets("sayfa1").Cells(a - 1, 1) + 1 & " kodlu ürün için koli içi adet giriniz:")
    Target = Sheets("sayfa1").Cells(a - 1, 1) + 1
    Target.Offset(0, 1) = Sheets("sayfa1").Cells(a, 2)
    Target.Offset(0, 2) = Sheets("sayfa1").Cells(a, 3)
    Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
Else
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 3, 0)
Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
End If
Target.Offset(0, 3).Select

End Sub
Genişletmek için tıkla ...



Verdiğiniz kod çok işime yaradı allah sizden razı olsun fakat sizden ricam eğer mümkünse her ürünün kendine göre bir kodu var bunu biz bilgisayar seri nosuna göre vermiyoruz

mesela eti cicibebe 1000 gr 13113
eti cici bebe 190 gr 19113

bilgisayardaki kodlar örnek olarak verilmiştir.
input box sayfasına ürün kodunu da ekleye bilirmiyiz yani bu numaralı ürünü eklemek istiyormusunuz yerine yazdığım kodu eklemek istiyormusunuz yazarsa sevinirim.
 
Şunu deneyin:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7:c100")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a" & a), Target) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, " & Target & " ürün koduyla eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    Sheets("sayfa1").Cells(a, 1) = Target
    Sheets("sayfa1").Cells(a, 2) = InputBox(Target & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Target & " kodlu ürün için koli içi adet giriniz:")
    
    Target.Offset(0, 1) = Sheets("sayfa1").Cells(a, 2)
    Target.Offset(0, 2) = Sheets("sayfa1").Cells(a, 3)
    Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
Else
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 3, 0)
Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
End If
Target.Offset(0, 3).Select

End Sub

Soruları sorarken dosyaya uygun sorarsak ya da örnek dosyayı soruya uygun hazırlarsak daha iyi olur.
 
YUSUF44' Alıntı:
Şunu deneyin:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c7:c100")) Is Nothing Then Exit Sub
    a = Sheets("sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("a2:a" & a), Target) = 0 Then
uyarı = MsgBox("Ürün bulunamadı, " & Target & " ürün koduyla eklemek ister misiniz?", vbYesNo)
    If uyarı = vbYes Then
    Sheets("sayfa1").Cells(a, 1) = Target
    Sheets("sayfa1").Cells(a, 2) = InputBox(Target & " kodlu ürünün adını giriniz:")
    Sheets("sayfa1").Cells(a, 3) = InputBox(Target & " kodlu ürün için koli içi adet giriniz:")
    
    Target.Offset(0, 1) = Sheets("sayfa1").Cells(a, 2)
    Target.Offset(0, 2) = Sheets("sayfa1").Cells(a, 3)
    Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
Else
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 2, 0)
Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("sayfa1").Range("A2:c" & a), 3, 0)
Target.Offset(0, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
End If
Target.Offset(0, 3).Select

End Sub

Soruları sorarken dosyaya uygun sorarsak ya da örnek dosyayı soruya uygun hazırlarsak daha iyi olur.
Genişletmek için tıkla ...

sorun çözüldü çok teşekkür ederim.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst