şartlı veri getirme

gedavet · 3 Aralık 2011

On Error Resume Next
If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D

"), Cells(Target.Row, "K")) > 0 Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
Else
Cells(Target.Row, "K") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If

bu koda şu şekilde mir mantık ilave etmek istiyorum bu işlemi yani yukarıdaki kodu a4 hücresinde alış yazıyor ise Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0) burdaki 3 sayısını 2 yapmak satış ise 3 yapmak

yani özetlecek olursam bu kod "k" sütunundaki yazan ürünün fiyatını ürünler sayfasından getiriyor ancak "a4" de alış yazıyor ise m sütunununa alış fiyatını satış yazıyor ise "p" sütunununa satış fiyatını getirmek istiyorum

gedavet · 5 Aralık 2011

iyi çalışmalar hocalarım bu konuda ban ayardımcı olabilirmisiniz kod bu şekli ile çalışı yor ancak dediğim gibi bana şartlı lazım eğer "a4" de alış yazıyorsa "m" sütunununa alış fiyatunı satış yazıyorsa "p" sütunununa satış fiyatınını üürnler sayfasından getirmesini istiyorum

mancubus · 6 Aralık 2011

bu satırı

Kod:

Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)

şu satırlar ile değiştirerek test edin:

Kod:

If UCase(Sheets("ÜRÜNLER").Range("A4").Value) = "ALIŞ" Then
    Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 2, 0)
ElseIf UCase(Sheets("ÜRÜNLER").Range("A4").Value) = "SATIŞ" Then
    Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
End If

gedavet · 8 Aralık 2011

hocam ilginiz için teşekkür ederim
ancak dediğinizi yaptıp ne alışa ne satışa fiyat getiriyor
yani ikisinede fiyatları getirmiyor
birde de alış yazıyor ise "m" sütunununa getirecek
satış yazıyor ise" p" sütunununa getirecek

gedavet · 8 Aralık 2011

yanlış anlaşılmasın yapmak istediğim şu ben işlemi başka bir sayfada yapmak istiyorum yani bu kod başika bir sayfada ürünler sayfasından fiyatları getirmesi lazım eskidenki kod o şekilde idi

mancubus · 8 Aralık 2011

tabii ben genel mantık olarak yazmıştım.
buradaki mantığı kendi dosyandaki duruma uyarlamak lazım.

Eğer Koşul1 Doğru ise
Bunu Yap
YokEğer Koşul2 Doğru ise
Şunu Yap
Başka Bir Şey Yapma

gedavet · 8 Aralık 2011

hocam sizin yazdığınız kod biirm fiyatlarını getirmiyor
1. mesajdaki kod sadece p sütunununa satış fiyatını getiriyor

sizin yazdığınız kod biraz yaklaştı ancak hiç biirm fiyatı getirmiyor nasıl düzenlememizlazım

mancubus · 8 Aralık 2011

dosyayı yükleme imkanı var ise ekleyelim.

gedavet · 8 Aralık 2011

http://www.excel.web.tr/f48/makrolary-birle-tirmek-farkly-sayfalardaki-kodlary-bir-sayfada-t107732.html

bu linkdeki dosya

mancubus · 8 Aralık 2011

evet...
çok karmaşık kodlar...
o konudaki soruya cevap veren bulmak zor.
dürüst olmak gerekirse, benim de girebileceğim gibi bir konu değil.

sadece bir konuda fikir vereyim. katkım o olsun. başka da vakit ayırmam mümkün değil.
vakti olan bir üyemiz gelişmesine yardımcı olabilir belki.

ama anladığım kadarı ile aktif olunan sayfadaki bir veriyi başka bir sayfada aratıp hizasındaki herhangi bir sütunda bulunan veri yazdırılacak.

aşağıdaki kodun yerine

Kod:

On Error Resume Next
If Not Intersect(Target, Range("G5:G1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "G")) > 0 Then
Cells(Target.Row, "I").Value = WorksheetFunction.VLookup(Cells(Target.Row, "G"), Sheets("ÜRÜNLER").Range("D:E"), 2, 0)
Else
Cells(Target.Row, "G") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
End If

şu kullanılabilir. tabii Offset'teki sütun sayılarını ayarlamak lazım. bulunan hücrenin 5 sütun sağındaki hücrenin verisi getirilecekse rBul.Offset(0, 5) olmalı... vs... vs...

Kod:

Dim rBul As Range
On Error Resume Next
Set rBul = Sheets("ÜRÜNLER").Range("D:D").Find(Target.Value)
If Not rBul Is Nothing Then
    If UCase(Range("A4").Value) = "ALIŞ" Then
        Cells(Target.Row, "I").Value = rBul.Offset(0, 1).Value 'D'yi 1 sütun sağa kaydırır E
    ElseIf UCase(Range("A4").Value) = "SATIŞ" Then
        Cells(Target.Row, "I").Value = rBul.Offset(0, 2).Value 'D'yi 2 sütun sağa kaydırır F
    End If
Else
    MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
On Error GoTo 0

not: hem selection change hem workshhet change var. onlarca defa On Error Resume Next veya Application.EnableEvents = False kullanılmış.

eğer Application.EnableEvents = False bir yerde takılı kaldı Application.EnableEvents = True demeden arka planda kodlar çalışmaz.

gedavet · 8 Aralık 2011

hocam en sonki kod a4 alış veya satış yazında üürn bulunamadu diye hata veriyor

3. mesajdaki kod biraz daha uygun gibi

If UCase(Sheets("buraya ürünlermi yazmak lazım bura içeriisndeki bulunduğum sayfa mı demek").Range("A4").Value) = "ALIŞ" Then
Cells(Target.Row, "M") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 2, 0)
ElseIf UCase(Sheets("buraya ürünlermi yazmak lazım bura içeriisndeki bulunduğum sayfa mı demek").Range("A4").Value) = "SATIŞ" Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
End If

gedavet · 8 Aralık 2011

hocam dosyayı tekrar yenisini ekledim kodlarda düzenleme yaptım

düzenleyemediğim iki husus var
cari sayfasında üürn yazınca a4 de alış yazıyorsa ürünler sayfasında alış fiyatı sütununa alış fiyatını satış isede satış fiyatına satış fiyatını getirmesi lazım

diğer bir hususda ürün özeti sayfasına tıklayınca cari sayfasındaki kalan adet sütunununa alınan adetten satılan adedi çıkarıp tutar sütununana da ürünler sayfasındaki alış biirm fiyatından çarpım tutarı hesaplaması

bu kodun biraz benzeri makrolardaki ürün akrat kodu buna benziyor başka aktarma işlemi var o kodda ancak burada aktarma olmayacak sadece dediğim hesaplama olacak ancak uyarlayamadım

bu iki hususa yardımcı olabilirmisiniz

mancubus · 8 Aralık 2011

Kod:

If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
    If Target = "" Then Exit Sub
    If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "K")) > 0 Then
        If UCase(Range("A4").Value) = "ALIŞ" Then
            Cells(Target.Row, "M") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 2, 0)
        ElseIf UCase(Range("A4").Value) = "SATIŞ" Then
            Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
        End If
    Else
        Cells(Target.Row, "K") = ""
        MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
    End If
End If

gedavet · 8 Aralık 2011

hocam çok teşekkür ederim ilgili biirm fiyatları geliyor

birde cari sayfasındaki en sondaki kalan adet ile tutarını yapabilirmisiniz

gedavet · 8 Aralık 2011

Sub AKTAR_ÜRÜN()
Dim S1 As Worksheet, S4 As Worksheet
Dim Satır_1 As Long, Satır_2 As Long, İlk_Satır As Long, Son_Satır As Long

Application.ScreenUpdating = False

Set S1 = Sheets("CARİ")
Set S4 = Sheets("ÜRÜNLER")

''''''''''''''''''''''' CARİ '''''''''''''''''''''''
S1.Range("B5:AI" & Rows.Count).ClearContents

S4.Range("IV5") = "=" & S4.Range("B5").Address(0, 0) & "&" & S4.Range("C5").Address(0, 0) & "&" & S4.Range("D5").Address(0, 0)
S4.Range("IV5").AutoFill Destination:=S4.Range("IV5:IV" & S4.Cells(Rows.Count, "B").End(3).Row)

S1.Range("AK5").Formula = "=AJ5*INDEX(ÜRÜNLER!E:E,MATCH(B5&D5&E5,ÜRÜNLER!IV:IV,0))"
S1.Range("AK5").AutoFill Destination:=S1.Range("AK5:AK" & Satır_1)
S1.Range("AK5:AK" & Satır_1).Value = S1.Range("AK5:AK" & Satır_1).Value

S1.Range("AJ" & İlk_Satır).Formula = "=L" & İlk_Satır & "-O" & İlk_Satır
S1.Range("AJ" & İlk_Satır).AutoFill Destination:=S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır)
S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır).Value = S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır).Value

S1.Range("AK" & İlk_Satır) = "=AJ" & İlk_Satır & "*INDEX(ÜRÜNLER!E:E,MATCH(B" & İlk_Satır & "&D" & İlk_Satır & "&E" & İlk_Satır & ",ÜRÜNLER!IV:IV,0))"
S1.Range("AK" & İlk_Satır).AutoFill Destination:=S1.Range("AK" & İlk_Satır & ":AK" & Son_Satır)
S1.Range("AK" & İlk_Satır & ":AK" & Son_Satır).Value = S1.Range("AK" & İlk_Satır & ":AK" & Son_Satır).Value

S4.Range("IV:IV").Delete

Set S1 = Nothing
Set S4 = Nothing

Application.ScreenUpdating = True
End Sub

bu kodu cari sayfasındaki ensonda kalan adet ve tutarı sütununa ürün özeti sayfasına tıklayınca çalışacak şekilde uyarlaay bilirmisiniz
bütün emeği ve yardımı geçen hocaalrıma teşkkür ediyorum
üsteki kodun içerisinde aktarma işlemi var o olmayacak sadece kalan adet ve tutarını hesaplayacak

gedavet · 8 Aralık 2011

hocalarım ilginiz için teşekkür ederim emeklerinize sağlık

yapmak istediğim şu ürün özeti sayfasına tıklayınca makrolardaki kodun çalışması
makrolardaki kod ise şunu yapmalı
1. L-O=AJ (aj sütununa yani kalan adet yazan sütuna L sütununu O sütunundan çıkarması (alınan adetten satılan adedi çıkarması)

2. AJ (kalan adedi) ürünler sayfasındaki alış fiyatı ile çarpması (örnekle açıklamak gerekirse diyelimki cari sayfada k5 de kalem yazıyorsa ürünler sayfasındaki kalemin alış fiyatı ile çarpması)

mancubus · 8 Aralık 2011

değişkenler:
Dim Satır_1 As Long, Satır_2 As Long, İlk_Satır As Long, Son_Satır As Long

yazılmış.

ama bunların ne olduğu, nasıl hesaplandığı belli değil.

Satır_1 = 15 (veya bu değeri hesaplayan bir kod) gibi bir ifade lazım.
aksi takdirde 0'dır ki JJ5:JJ0 anlamsız bir aralıktır ve hata verir.

bu gibi detaylar...

mancubus · 8 Aralık 2011

Kod:

S1.Range("AJ" & İlk_Satır).Formula = "=L" & İlk_Satır & "-O" & İlk_Satır
S1.Range("AJ" & İlk_Satır).AutoFill Destination:=S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır)
S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır).Value = S1.Range("AJ" & İlk_Satır & ":AJ" & Son_Satır).Value

yerine

Kod:

S1.Range("AJ5:AJ" & Son_Satır).Formula = "=L5-O5"
S1.Calculate
S1.Range("AJ5:AJ" & Son_Satır).Value = S1.Range("AJ5:AJ" & Son_Satır).Value

kullanılabilir. diğer formüller de buna göre uyarlanabilir.

gedavet · 8 Aralık 2011

kodun içinde aktarma kodu var onu çıkarmamız lazım sadece deminki yazdığım hesaplamayı yapması lazım

gedavet · 8 Aralık 2011

Sub AKTAR_ÜRÜN()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, S4 As Worksheet
Dim Satır_1 As Long, Satır_2 As Long, İlk_Satır As Long, Son_Satır As Long

Application.ScreenUpdating = False

Set S1 = Sheets("ÜRÜN")
Set S2 = Sheets("ALIŞ")
Set S3 = Sheets("SATIŞ")
Set S4 = Sheets("ÜRÜNLER")

''''''''''''''''''''''' ÜRÜN '''''''''''''''''''''''
S1.Range("B5:K" & Rows.Count).ClearContents

S4.Range("IV5") = "=" & S4.Range("B5").Address(0, 0) & "&" & S4.Range("C5").Address(0, 0) & "&" & S4.Range("D5").Address(0, 0)
S4.Range("IV5").AutoFill Destination:=S4.Range("IV5:IV" & S4.Cells(Rows.Count, "B").End(3).Row)

''''''''''''''''''''''' ALIŞ '''''''''''''''''''''''
Satır_1 = S2.Cells(Rows.Count, 2).End(3).Row
S1.Range("B5:C" & Satır_1).Value = S2.Range("B5:C" & Satır_1).Value
S1.Range("D5:F" & Satır_1).Value = S2.Range("F5:H" & Satır_1).Value
S1.Range("G5:G" & Satır_1).Value = S2.Range("J5:J" & Satır_1).Value
S1.Range("J5").Formula = "=F5-H5"
S1.Range("J5").AutoFill Destination:=S1.Range("J5:J" & Satır_1)
S1.Range("J5:J" & Satır_1).Value = S1.Range("J5:J" & Satır_1).Value

S1.Range("K5").Formula = "=J5*INDEX(ÜRÜNLER!E:E,MATCH(B5&D5&E5,ÜRÜNLER!IV:IV,0))"
S1.Range("K5").AutoFill Destination:=S1.Range("K5:K" & Satır_1)
S1.Range("K5:K" & Satır_1).Value = S1.Range("K5:K" & Satır_1).Value

''''''''''''''''''''''' SATIŞ '''''''''''''''''''''''
Satır_2 = S3.Cells(Rows.Count, 2).End(3).Row
İlk_Satır = Satır_1 + 1
Son_Satır = İlk_Satır + Satır_2 - 5
S1.Range("B" & İlk_Satır & ":C" & Son_Satır).Value = S3.Range("B5:C" & Son_Satır).Value
S1.Range("D" & İlk_Satır & ":E" & Son_Satır).Value = S3.Range("I5:J" & Son_Satır).Value
S1.Range("H" & İlk_Satır & ":H" & Son_Satır).Value = S3.Range("K5:K" & Son_Satır).Value
S1.Range("I" & İlk_Satır & ":I" & Son_Satır).Value = S3.Range("M5:M" & Son_Satır).Value

S1.Range("J" & İlk_Satır).Formula = "=F" & İlk_Satır & "-H" & İlk_Satır
S1.Range("J" & İlk_Satır).AutoFill Destination:=S1.Range("J" & İlk_Satır & ":J" & Son_Satır)
S1.Range("J" & İlk_Satır & ":J" & Son_Satır).Value = S1.Range("J" & İlk_Satır & ":J" & Son_Satır).Value

S1.Range("K" & İlk_Satır) = "=J" & İlk_Satır & "*INDEX(ÜRÜNLER!E:E,MATCH(B" & İlk_Satır & "&D" & İlk_Satır & "&E" & İlk_Satır & ",ÜRÜNLER!IV:IV,0))"
S1.Range("K" & İlk_Satır).AutoFill Destination:=S1.Range("K" & İlk_Satır & ":K" & Son_Satır)
S1.Range("K" & İlk_Satır & ":K" & Son_Satır).Value = S1.Range("K" & İlk_Satır & ":K" & Son_Satır).Value

S4.Range("IV:IV").Delete

Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
Set S4 = Nothing

Application.ScreenUpdating = True
End Sub

kodun aslı bu bu şekli ile başka biryerde çalışıyor alış ve satış sayfasından veri aktarıyor sonrada dediğim hesaplamayı yapıyor bana sadece hesaplaması lazım aktaram kısmı lazım değil

şartlı veri getirme

gedavet

gedavet

mancubus

Destek Ekibi

gedavet

gedavet

mancubus

Destek Ekibi

gedavet

mancubus

Destek Ekibi

gedavet

mancubus

Destek Ekibi

gedavet

gedavet

Ekli dosyalar

mancubus

Destek Ekibi

gedavet

gedavet

gedavet

mancubus

Destek Ekibi

mancubus

Destek Ekibi

gedavet

gedavet