• DİKKAT

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

veri arama

  • Konbuyu başlatan Konbuyu başlatan afiss
  • Başlangıç tarihi Başlangıç tarihi
A

afiss

Katılım
24 Mart 2008
Mesajlar
8
Excel Vers. ve Dili
türkce 2003
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
 
afiss' Alıntı:
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
Genişletmek için tıkla ...

Dosyanız hazır.:cool:
Kod: 
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
 
Son düzenleme:
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.
 
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
 
Evren Gizlen' Alıntı:
Dosyanız hazır.:cool:
Kod: 
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
Genişletmek için tıkla ...

öncelikle cok tşk ederim.yanlız dosyanızı acamıyorum.
 
afiss' Alıntı:
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
Genişletmek için tıkla ...


Zaten verdiğim dosyada bu özellik var.
 
Evren Gizlen' Alıntı:
Dosyayı 2 numaralı mesajda xls formatlı ekledim.
İnceleyebilirsiniz.:cool:
Genişletmek için tıkla ...
ç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.
 
afiss' Alıntı:
ç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.
Genişletmek için tıkla ...
Benim yaptığım dosyada çıkıyordu.
Dosyayı ekleyin bir bakalım.:cool:
Butona basıyormusunuz?
 
afiss' Alıntı:
listele dediğim zaman makro güvenlik düzeyi ile ilgili bi uyarı cıkıyor
Genişletmek için tıkla ...
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
 
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
 
afiss' Alıntı:
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
Genişletmek için tıkla ...

İstediğiniz düzenlemeyi yaptım.
Dosyanız ektedir.:cool:
Kod: 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst