iki kritere göre arama ve sonucu aktarma

[yakup123]

merhaba
ekteki dosyada Userform 1 in listboxında seçilen kaydın bilgilerini üst forma taşıyor ben bak ve aktar tuşuna basınca bu kayıttaki bölgeyi ve ciroyu hedef sayfasında bulacak bölge aynıysa ve ciroda hedefteki cirodan büyükse bu kayıdın tüm bilgilerini Tutturanlar sayfasına aktaracak aktarma işlemi sonrasında extra bir kolon daha açııcak ve Ok cumlesini yazacak


yani bir değerlendirme istiyorum 2 kritere göre ama list boxtan seçilen kayda göre tum kayıtları değil ve sonucu aktarması ekteki dosyada herşey hazır bir bak ve aktar tuşunun usttekı ıstediğim kodunu yazamadım

 

[Mahmut Kök]

Anladığım kadarıyla bir şeyler yapmaya çalıştım. bir deneyiniz.

Sub bakveaktar()
Dim s1, s2, s3 As Worksheet
Dim bolge As String
Dim ciro As Double
Dim sonsat As Integer
Dim secimindeks As Integer
Set s1 = Sheets("Şubeler")
Set s2 = Sheets("Hedef")
Set s3 = Sheets("Tutturanlar")
secimindeks = CInt(TextBox1.Text)
bolge = TextBox4.Text
ciro = CDbl(TextBox3.Text)
Set ara = s2.Range("b2:b65536").Find(bolge)
If ara Is Nothing Then Exit Sub
If CDbl(s2.Cells(ara.Row, "C").Text) < ciro Then
sonsat = s3.Range("A65536").End(3).Row
s3.Range("A" & sonsat + 1 & ":E" & sonsat + 1).Value = s1.Range("A" & secimindeks + 1 & ":E" & secimindeks + 1).Value
MsgBox ("Aktarıldı. Nereye TAMAM yazılacağını anlayamadığımdan o kısmı yapamadım :) ")
End If
End Sub

 

[yakup123]

hocam çok teşekkürler en sonuncusu su
1 eren 1400 kadıköy ali terel
yazıyor ya bunlardan zıyade f kolonunada ok yazabilirmi acaba

 

[Mahmut Kök]

Aşağıdaki satırı MsgBox ..' un olduğu satırla değiştirip deneyiniz.

s1.Range("F" & secimindeks + 1) = "TMM" 's1 Şubeler sayfası.  Eğer Tutturulanlar sayfasına yazdırmak istiyorsanız S1 i S3 yapın.

 

[yakup123]

hocam çok teşekkürler süper oldu valla elinize sağlık
saygılarımla