• DİKKAT

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

Vseç formülünden sayısal sonucun listesini almak

E

erseljti

Katılım
20 Ocak 2012
Mesajlar
118
Excel Vers. ve Dili
Office 2016-Türkçe
Sorunum ektedir.çözüm alanını tam bilemediğim için bu alana gönderiyorum.yardımcı olursanız sevinirim.
 

Ekli dosyalar

Merhaba,

Bu şekilde büyük dosyalarda fonksiyon değil makro kullanmak en doğrusu olur.

Esasında bu işlem excelin yerleşik menülerinde mevcuttur. Filtre seçeneklerinden "Gelişmiş Filtre" yönetimi ile yapabilirsiniz.

Makroya uygulanmış hali ektedir.

Ek olarak ben Menü sayfası A1 hücresinde Bayi Adını Data sayfasında göremedim. Sayfalarıdaki başlıkları aynı sütunda ve isimde tutmanız gerekmektedir. Eğer farklılık varsa siz düzeltip kodlardaki aralığı ona göre değiştirirsiniz.


Module kopyalayın ve bir butona atayıp çalıştırın.

Kod: 
Sub Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("SONUÇ").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A1:E" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:E2"), CopyToRange:=Range("A1")
 
End Sub
.
 
ömer' Alıntı:
merhaba,

bu şekilde büyük dosyalarda fonksiyon değil makro kullanmak en doğrusu olur.

Esasında bu işlem excelin yerleşik menülerinde mevcuttur. Filtre seçeneklerinden "gelişmiş filtre" yönetimi ile yapabilirsiniz.

Makroya uygulanmış hali ektedir.

Ek olarak ben menü sayfası a1 hücresinde bayi adını data sayfasında göremedim. Sayfalarıdaki başlıkları aynı sütunda ve isimde tutmanız gerekmektedir. Eğer farklılık varsa siz düzeltip kodlardaki aralığı ona göre değiştirirsiniz.


Module kopyalayın ve bir butona atayıp çalıştırın.

Kod: 
sub suzme()
 
    dim sm as worksheet, sd as worksheet, son as long
 
    set sm = sheets("menü")
    set sd = sheets("data")
 
    application.screenupdating = false
 
    sheets("sonuç").select
 
    son = sd.cells(rows.count, "a").end(xlup).row
    cells.clear
 
    sd.range("a1:e" & son).advancedfilter action:=xlfiltercopy, _
        criteriarange:=sm.range("a1:e2"), copytorange:=range("a1")
 
end sub
.
Genişletmek için tıkla ...

hocam çok teşekkürler.gördümki excelde yapılamayacak hiç bir şey yok.benim çalışmam çok kabarık adımlardan oluşuyor.sizin verdiğiniz mantıkla çalışmama başlıyorum.takıldığım noktalarda yardımınıza başvurabilir miyim.
 
Tabiki sorabilirsiniz. Ben yada farklı bir arkadaşımız elimizden geldiğince yardımcı olmaya çalışırız.
 
hOCAM İŞİN İÇİNDEN ÇIKAMADIM.sORUNU EKTE DETAYLADIM.LÜTFEN YARDIMCI OLUN
 

Ekli dosyalar

Ne yapmak istediğinizi anlayamadım.

Sonuc ve penetrasyon sayfasına olmasını istediğiniz şeklli manuel hazırlayıp, dosyayı küçültüp daha sade şeklini ekleyip açıklarmısınız.
 
ömer' Alıntı:
ne yapmak istediğinizi anlayamadım.

Sonuc ve penetrasyon sayfasına olmasını istediğiniz şeklli manuel hazırlayıp, dosyayı küçültüp daha sade şeklini ekleyip açıklarmısınız.
Genişletmek için tıkla ...

hocam dosyayı istediğiniz şekilde değiştirip açıklamaları dahada detaylandırdım.yardımlarınızı rica ederim.Konu benim için çok önemli lütfen yardımınızı esirgemeyin
 

Ekli dosyalar

Son düzenleme:
hocam dosyayı istediğiniz şekilde değiştirip açıklamaları dahada detaylandırdım.yardımlarınızı rica ederim.Konu benim için çok önemli lütfen yardımınızı esirgemeyin
 

Ekli dosyalar

erseljti' Alıntı:
hocam dosyayı istediğiniz şekilde değiştirip açıklamaları dahada detaylandırdım.yardımlarınızı rica ederim.Konu benim için çok önemli lütfen yardımınızı esirgemeyin
Genişletmek için tıkla ...

Sevgili Üstadlar Acil yetiştirmem gereken raporum Var sorunumu EK li dosyada anlatabildiğim kadarıyla detaylandırdım.Yardımlarınızı rica ederim
 
Eski kodları silin ve aşağıdaki kodları kullanın. Kodları başlık adına göre butona atarsınız.

Kod: 
Sub Sonuc_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("SONUÇ").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:M" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
 
End Sub
'---------------------------------------------------------------
Sub Penetrasyon_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long, i As Integer
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("PENETRASYON").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:AK" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 9 Step -4
        Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
    Next i
 
 
End Sub

.
 
Ömer' Alıntı:
Eski kodları silin ve aşağıdaki kodları kullanın. Kodları başlık adına göre butona atarsınız.

Kod: 
Sub Sonuc_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("SONUÇ").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:M" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
 
End Sub
'---------------------------------------------------------------
Sub Penetrasyon_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long, i As Integer
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("PENETRASYON").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:AK" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 9 Step -4
        Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
    Next i
 
 
End Sub

.
Genişletmek için tıkla ...

Hocam teşekkür ederim ellerinize ve emeğinize sağlık
Range("G:J").Delete
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 9 Step -4
Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
Next i
Hocam makronun bu son kısmında yazan codelerin anlamı nedir açılımını yaparmısınız.Ben düğme sayısını çoğaltıp Penetrasyon Sheetine diğer ürünleri de alacağım zannedersem bu alanda değişiklik yapmam lağzım.uğraştım yapamadım
 
Range("G:J").Delete
G:J sütunları arasını siler. Bu kısmı raporda istemediğiniz için sildirdim.
-------------------------------------------------------------------------------

For i = Cells(1, Columns.Count).End(xlToLeft).Column To 9 Step -4
1. satırın sütundaki son değerini bularak geriye doğru 4 satır atlararak 9. sütuna gelene kadar döngü kurar.
-------------------------------------------------------------------------------

Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
Döngü sonucundan elde edilen sütun indekslerini 3 sütun birleştirir ve ilgili sütunları siler.
-------------------------------------------------------------------------------

Next i
Döngü sonu.

Bu döngüyü tabloda istemediğiniz sütunları silmek için kullandık. Kısaca açıklaması bu şekildedir.

.
 
Ömer' Alıntı:
Range("G:J").Delete
G:J sütunları arasını siler. Bu kısmı raporda istemediğiniz için sildirdim.
-------------------------------------------------------------------------------

For i = Cells(1, Columns.Count).End(xlToLeft).Column To 9 Step -4
1. satırdaki son değeri bularak geriye doğru 4 satır atlararak 9. sütuna gelene kadar döngü kurar.
-------------------------------------------------------------------------------

Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
Döngü sonucundan elde edilen sütun indekslerini 3 sütun birleştirir ve ilgili sütunları siler.
-------------------------------------------------------------------------------

Next i
Döngü sonu.

Bu döngüyü tabloda istemediğiniz sütunları silmek için kullandık. Kısaca açıklaması bu şekildedir.

.
Genişletmek için tıkla ...


Hocam çok teşekkür ederim...
 
İşin içinden çıkamıyorum
 
Son düzenleme:
Sevgili Üstadlar,
Ömer Hocam ciddi derecede destek verdi.Artık Ömer Hocadan yardım istemeye yüzüm kalmadı.Çok uğraştım sabahtan beri uğraşıyorum.Çalışmamı tamamlayamadım.Sorunumu Ek li dosyada açıklamaya çalıştım.Yardımlarınızı rica ederim
 

Ekli dosyalar

PENETRASYON 2 sayfası için:

Kod: 
Sub Penetrasyon2_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long, i As Integer
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("PENETRASYON 2").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:AK" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
    For i = Cells(1, Columns.Count).End(xlToLeft).Column + 1 To 9 Step -4
        Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
    Next i
    Range("G:G").Delete
 
End Sub

PENETRASYON 3 sayfası "CAMEL BLACK" için:

Kod: 
Sub Penetrasyon3_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long, i As Integer
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("PENETRASYON 3").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:AK" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
    For i = Cells(1, Columns.Count).End(xlToLeft).Column + 2 To 9 Step -4
        Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
    Next i
    Range("G:H").Delete
 
End Sub

PENETRASYON 4 sayfası "CAMEL WHİTE" için: ( Bu şekilde bir sayfa göremediğim için PENETRASYON 4 sayfası açarak yazdım.)

Kod: 
Sub Penetrasyon4_Suzme()
 
    Dim Sm As Worksheet, Sd As Worksheet, son As Long, i As Integer
 
    Set Sm = Sheets("Menü")
    Set Sd = Sheets("Data")
 
    Application.ScreenUpdating = False
 
    Sheets("[COLOR=blue]PENETRASYON 4[/COLOR]").Select
 
    son = Sd.Cells(Rows.Count, "A").End(xlUp).Row
    Cells.Clear
 
    Sd.Range("A2:AK" & son).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sm.Range("A1:I2"), CopyToRange:=Range("A1")
 
    Range("G:J").Delete
    For i = Cells(1, Columns.Count).End(xlToLeft).Column + 3 To 9 Step -4
        Range(Cells(1, i - 2), Cells(Rows.Count, i)).Delete
    Next i
    Range("G:I").Delete
 
End Sub

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst