Ürünün fiyatını kodla çekme

[Epakambalaj]

Excel Versiyonu

Excel 2016

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Hayırlı akşamlar üstadlarım.

B hücresinde ürün girdiğimizde
C hücresine satış fiyatını çekmek istiyoruz.

Ürün listemiz D sütununda
Fiyat listemiz E sütununda.

Şimdiden teşekkür ediyorum

 

Hazır Faturayı Printerdan çıkartma

listboxa tablo verisini getirme

[Feyzullah]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Value = "" Then Me.Cells(Target.Row, 3) = ""
Set ara = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Me.Cells(Target.Row, 3) = Cells(ara.Row, "E")
End If
End Sub

 

[Epakambalaj]

Ellerinize sağlık @Feyzullah hocam.

Aynı mantık üzerinden,

C hücresini çift tıklandığımızda,
B deki ürüne göre fiyat getirmek mümkün müdür?

Burada B hücresine veri girdiğimizde C de veri alıyoruz.
B de veri var olduğu halde, C deki veriyi manuel olarak sildiğimizi düşünelim.
B yi çift tıklasak C ye veri gelecek.
Peki içi boş olan C yi çift tıkladığımızda yine C de verinin gelmesi mümkin müdür?

 

[Feyzullah]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 3 Then Exit Sub
Set ara = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 2))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "E")
End If
End Sub

 

[hakki83]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Value = "" Then Me.Cells(Target.Row, 3) = ""
Set ara = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Me.Cells(Target.Row, 3) = Cells(ara.Row, "E")
End If
End Sub

Sayın Feyzullah merhaba
yukardaki kodların

A sütununda ürün listesi, B sütununda ise fiyatları olduğunu düşünürsek
ve

E sütununa girdiğimiz kodları
F sütununa fiyatları getirecek şekilde değiştirir misiniz

Yapmaya çalıştım ama olmadı hata verdi.
5 leri 2 yaptım
4 leri 1 yaptım olmadı

 

[Epakambalaj]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 3 Then Exit Sub
Set ara = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 2))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "E")
End If
End Sub

Ellerinize sağlık üstadım.
Kadir Geceniz Mübarek Olsun.
Çözüldü.

 

[Epakambalaj]

Sayın Feyzullah merhaba
yukardaki kodların

A sütununda ürün listesi, B sütununda ise fiyatları olduğunu düşünürsek
ve

E sütununa girdiğimiz kodları
F sütununa fiyatları getirecek şekilde değiştirir misiniz

Yapmaya çalıştım ama olmadı hata verdi.
5 leri 2 yaptım
4 leri 1 yaptım olmadı

iyi günler

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Me.Cells(Target.Row, 3) = ""
Set ara = Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Me.Cells(Target.Row, 6) = Cells(ara.Row, "B")
End If
End Sub

doğru anladıysam eğer.

 

[Epakambalaj]

tam çözülmedi

Hayırlı akşamlar @Feyzullah hocam.

Tam olarak uyarladığımız kod aşağıda.
Kodlar tek tek çalışıyor fakat bir araya getirince sadece ilk kod çalışıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column <> 8 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 7))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

If Target.Column <> 11 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 10))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

If Target.Column <> 14 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 13))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

End Sub

 

[hakki83]

iyi günler

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Me.Cells(Target.Row, 3) = ""
Set ara = Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Me.Cells(Target.Row, 6) = Cells(ara.Row, "B")
End If
End Sub

doğru anladıysam eğer.

Sayın Epak ambalaj çok teşekkürler, fakat elle girdiğimiz sütunu silmek istediğimizde hata veriyor. Benim denediğimde de aynj hata olmuştu. Sanıyorum Sayın Feyzullah’ın elinin değmesi lazım.

 

[Feyzullah]

Sayın Epak ambalaj çok teşekkürler, fakat elle girdiğimiz sütunu silmek istediğimizde hata veriyor. Benim denediğimde de aynj hata olmuştu. Sanıyorum Sayın Feyzullah’ın elinin değmesi lazım.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Cells(Target.Row, "F") = ""
Set ara = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Cells(Target.Row, "F") = Cells(ara.Row, "B")
End If
End Sub

 

[Feyzullah]

tam çözülmedi

Hayırlı akşamlar @Feyzullah hocam.

Tam olarak uyarladığımız kod aşağıda.
Kodlar tek tek çalışıyor fakat bir araya getirince sadece ilk kod çalışıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column <> 8 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 7))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

If Target.Column <> 11 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 10))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

If Target.Column <> 14 Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, 4).End(xlUp).Row).Find(Me.Cells(Target.Row, 13))
If Not ara Is Nothing Then
Target = Cells(ara.Row, "S")
End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("H:H,K:K,N:N")) Is Nothing Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, "R").End(xlUp).Row).Find(Me.Cells(Target.Row, 7))
If Not ara Is Nothing Then Target = Cells(ara.Row, "S")
End Sub

 

[hakki83]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Cells(Target.Row, "F") = ""
Set ara = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(Target.Value)
If Not ara Is Nothing Then
Cells(Target.Row, "F") = Cells(ara.Row, "B")
End If
End Sub

Sayın Feyzullah oldu. İlginiz için teşekkür ederim. Saygılar

 

[Epakambalaj]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("H:H,K:K,N:N")) Is Nothing Then Exit Sub
Set ara = Range("R1:R" & Cells(Rows.Count, "R").End(xlUp).Row).Find(Me.Cells(Target.Row, 7))
If Not ara Is Nothing Then Target = Cells(ara.Row, "S")
End Sub

Ellerinize sağlık @Feyzullah üstadım.
Allâh iyiliğinizi versin.
Bu vesile ile hepinizin bayramı mübârek olsun.
Çözüldü

 

[Feyzullah]

Ellerinize sağlık @Feyzullah üstadım.
Allâh iyiliğinizi versin.
Bu vesile ile hepinizin bayramı mübârek olsun.
Çözüldü

Sağolun, Esen Kalın.