veri arama

[afiss]

arkadaslar ekteki dosyayı inceleyip bana bilgi verirseniz cok sevinirim.
istediğim sey bi bi sayfadaki genel listede yazılı olan bilgileri diğer sayfada secenekli olarak aramam

 

[Orion1]

arkadaslar ekteki dosyayı inceleyip bana bilgi verirseniz cok sevinirim.
istediğim sey bi bi sayfadaki genel listede yazılı olan bilgileri diğer sayfada secenekli olarak aramam

Dosyanız hazır.

Sub listele()
Dim renk As String, i As Long, s2 As Worksheet
Dim musteri As String, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B7:E65536").ClearContents
Set s1 = Sheets("boyalı satışlar")
sat = 7
For i = 6 To s1.Cells(65536, "A").End(xlUp).Row
    If Range("B6").Value = "HEPSİ" Or Range("B6").Value = "" Then
        renk = s1.Cells(i, "F").Value
        Else
        renk = Range("B6").Value
    End If
    If UCase(Replace(Replace(Range("C6").Value, "ı", "I"), "i", "İ")) = "hepsi" Or _
    Range("C6").Value = "" Then
        musteri = s1.Cells(i, "C").Value
        Else
        musteri = Range("C6").Value
    End If
    If renk = s1.Cells(i, "F").Value And _
    musteri = s1.Cells(i, "C").Value Then
        Cells(sat, "B").Value = s1.Cells(i, "F").Value
        Cells(sat, "C").Value = s1.Cells(i, "C").Value
        Cells(sat, "D").Value = s1.Cells(i, "E").Value
        Cells(sat, "E").Value = s1.Cells(i, "H").Value
        sat = sat + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
    

End Sub

 

[Ali]

Sayfa1'deki B6 hücresine kırmızı yazarsanız kırmızıya ait parti no ve miktarlar listelenir. C6 hücresinede a firması yazarsanız kırmızı ve a firması olanların parti no ve miktarları listelenir.

Not: Yeşil zeminli alandaki formüller dizi formülü olup CTRL+SHIFT+ENTER tuşlarına basılarak girilmiştir.

Örnek dosyanız ektedir.

 

[afiss]

arkadaslar yardımlarınız için cok tşk ederim. peki söyle bişey yapabilirmiyiz.bi firmaya birden cok partide ve renkte kumas veriyorum firma ismini yazdıgım zaman otomatik olarak hangi renk vepartide kumas verdiğimi görebilirmiyim o müşteriye ait.veya aynı renkte birden fazla müşteriye kumas veriyorum.rengi yazdıgım zaman verdiğim firmaların listesini cıkarabilirmiyiz.şimdiden cok tşk ederim

 

[afiss]

Dosyanız hazır.

Sub listele()
Dim renk As String, i As Long, s2 As Worksheet
Dim musteri As String, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B7:E65536").ClearContents
Set s1 = Sheets("boyalı satışlar")
sat = 7
For i = 6 To s1.Cells(65536, "A").End(xlUp).Row
    If Range("B6").Value = "HEPSİ" Or Range("B6").Value = "" Then
        renk = s1.Cells(i, "F").Value
        Else
        renk = Range("B6").Value
    End If
    If UCase(Replace(Replace(Range("C6").Value, "ı", "I"), "i", "İ")) = "hepsi" Or _
    Range("C6").Value = "" Then
        musteri = s1.Cells(i, "C").Value
        Else
        musteri = Range("C6").Value
    End If
    If renk = s1.Cells(i, "F").Value And _
    musteri = s1.Cells(i, "C").Value Then
        Cells(sat, "B").Value = s1.Cells(i, "F").Value
        Cells(sat, "C").Value = s1.Cells(i, "C").Value
        Cells(sat, "D").Value = s1.Cells(i, "E").Value
        Cells(sat, "E").Value = s1.Cells(i, "H").Value
        sat = sat + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
    

End Sub

öncelikle cok tşk ederim.yanlız dosyanızı acamıyorum.

 

[Ali]

arkadaslar yardımlarınız için cok tşk ederim. peki söyle bişey yapabilirmiyiz.bi firmaya birden cok partide ve renkte kumas veriyorum firma ismini yazdıgım zaman otomatik olarak hangi renk vepartide kumas verdiğimi görebilirmiyim o müşteriye ait.veya aynı renkte birden fazla müşteriye kumas veriyorum.rengi yazdıgım zaman verdiğim firmaların listesini cıkarabilirmiyiz.şimdiden cok tşk ederim

Zaten verdiğim dosyada bu özellik var.

 

[afiss]

Zaten verdiğim dosyada bu özellik var.

kusura bakmayın dosyayı acamadıgım için inceleme fırsatı bulamadım.

 

[Orion1]

öncelikle cok tşk ederim.yanlız dosyanızı acamıyorum.

Dosyayı 2 numaralı mesajda xls formatlı ekledim.
İnceleyebilirsiniz.

 

[afiss]

Dosyayı 2 numaralı mesajda xls formatlı ekledim.
İnceleyebilirsiniz.

çok tşk ederim yardımlarınız için.biraz fazla oldu ama belkide benim yanlıs yaptıgım bişeyler var renk secme yaptıgım zaman assagıdaki listede sectiğim rengin dökümü cıkmıyor.

 

[Orion1]

çok tşk ederim yardımlarınız için.biraz fazla oldu ama belkide benim yanlıs yaptıgım bişeyler var renk secme yaptıgım zaman assagıdaki listede sectiğim rengin dökümü cıkmıyor.

Benim yaptığım dosyada çıkıyordu.
Dosyayı ekleyin bir bakalım.
Butona basıyormusunuz?

 

[afiss]

Benim yaptığım dosyada çıkıyordu.
Dosyayı ekleyin bir bakalım.
Butona basıyormusunuz?

listele dediğim zaman makro güvenlik düzeyi ile ilgili bi uyarı cıkıyor

 

[Orion1]

listele dediğim zaman makro güvenlik düzeyi ile ilgili bi uyarı cıkıyor

Araçlar==>Seçenekler==>Güvenlik==>Makro Güvenliği==>Güvenlik Düzeyinden
Düşük(Önerilmez'i) Seçin Tamam'a basın Excel'i kapatıp açın ondan sonra Butonu (Makroyu) çalıştırın

 

[afiss]

yardımların için cok cok ama cok tşk ederim.istediğim raporlamayı yakalıyorum yavas yavas.birde listele dediğim zaman orda bir sütun daha acıp kumas cinsinide görmeme yardımcı olabilirmisin.veya msn adresini verirsen daha fazla bilgi edinebilirim sizden tabi ib sakıncası yoksa

 

[Orion1]

yardımların için cok cok ama cok tşk ederim.istediğim raporlamayı yakalıyorum yavas yavas.birde listele dediğim zaman orda bir sütun daha acıp kumas cinsinide görmeme yardımcı olabilirmisin.veya msn adresini verirsen daha fazla bilgi edinebilirim sizden tabi ib sakıncası yoksa

İstediğiniz düzenlemeyi yaptım.
Dosyanız ektedir.

Sub listele()
Dim renk As String, i As Long, s2 As Worksheet
Dim musteri As String, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B7:E65536").ClearContents
Set s1 = Sheets("boyalı satışlar")
sat = 7
For i = 6 To s1.Cells(65536, "A").End(xlUp).Row
    If Range("B6").Value = "HEPSİ" Or Range("B6").Value = "" Then
        renk = s1.Cells(i, "F").Value
        Else
        renk = Range("B6").Value
    End If
    If UCase(Replace(Replace(Range("C6").Value, "ı", "I"), "i", "İ")) = "hepsi" Or _
    Range("C6").Value = "" Then
        musteri = s1.Cells(i, "C").Value
        Else
        musteri = Range("C6").Value
    End If
    If renk = s1.Cells(i, "F").Value And _
    musteri = s1.Cells(i, "C").Value Then
        Cells(sat, "B").Value = s1.Cells(i, "F").Value
        Cells(sat, "C").Value = s1.Cells(i, "C").Value
        Cells(sat, "D").Value = s1.Cells(i, "G").Value
        Cells(sat, "E").Value = s1.Cells(i, "E").Value
        Cells(sat, "F").Value = s1.Cells(i, "H").Value
        sat = sat + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
    

End Sub