Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 04-11-2014, 10:10   #1
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan çoketopla makro ile

Merhaba,

Ekteki dosyada normal bir çoketopla fonksiyonu uygulaması mevcut. Bu fonksiyonu makroya nasıl çevirebiliriz. Bu işlemi özet tablo şeklinde yapılabilir diyenler olabilir. Ancak veriler hem çok fazla hem de ekteği Tablo adlı sayfadaki uygulamaya benzer bir makrı çözüm daha kullanışlı gelmekte bana göre. Forumda biryerde benzeri bir uygulama vardı ancak tam olarak benim istedim uygulamaya benzemiyordu. Eni boyu değişebilecek bir çözüm üretmem gerekli. Sanırım yazılacak kodda sayfa adları ve sütunlar belirtilecektir. İlgili kodda sayfa adını ve sütunları değiştirebiliyor olmam gerekli.

Teşekkürler,
Eklenmiş Dosyalar
Dosya Türü: xlsm Çoketopla_Makro.xlsm (18.5 KB, 61 Görüntülenme)
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2014, 10:21   #2
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Benzeri bir soru daha önce aşağıda olduğu gibi gelmiş ve cevaplanmış.

SORU

=ÇOKETOPLA(satış!$K:$K;satış!$A:$A;$H$2;satış!$E:$ E;$E3)

bu formulu yaşlandırma adında sayfanın h3 hücresine yazıp aşağı doğru çekip
e stunun girilmiş verilere göre satış sayfasından çekip işlemi yapabiliyorum.
bunu makro ile yapabilme şansımız varmı

CEVAP

Merhaba,

Bu şekilde deneyin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub BulTopla()

Dim Ss As Worksheet, c As Range, i As Long, Adr As String

Set Ss = Sheets("satış")

Application.ScreenUpdating = False
Sheets("yaşlandırma").Select
Range("H3:H" & Rows.Count).ClearContents

For i = 3 To Cells(Rows.Count, "E").End(xlUp).Row
With Ss.Range("E:E")
Set c = .Find(Cells(i, "E"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If Ss.Cells(c.Row, "A") = Range("H2") Then
Cells(i, "H") = Cells(i, "H") + Ss.Cells(c.Row, "K")
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next i

Application.ScreenUpdating = True

End Sub
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2014, 10:41   #3
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,553
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub KOD()
    Application.ScreenUpdating = False
    Dim SV As Worksheet: Set SV = Sheets("Veri")
    Dim ST As Worksheet: Set ST = Sheets("Tablo")
    
    ST.Range("A2:D" & Rows.Count).ClearContents
    sat = 2
    For i = 2 To SV.Cells(Rows.Count, "B").End(3).Row
        If WorksheetFunction.CountIf(SV.Range("B2:B" & i), SV.Cells(i, "B")) = 1 Then
            ST.Cells(sat, "A") = SV.Cells(i, "B")
            ST.Cells(sat, "B") = SV.Cells(i, "C")
            ST.Cells(sat, "C") = WorksheetFunction.SumIf(SV.Range("B:B"), SV.Cells(i, "B"), SV.Range("E:E"))
            ST.Cells(sat, "D") = WorksheetFunction.SumIf(SV.Range("B:B"), SV.Cells(i, "B"), SV.Range("F:F"))
            sat = sat + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub
. . .
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
http://www.excel.web.tr/f59/rnek-dosya-hazyrlarken-dikkat-edilmesi-gerekenler-t134225.html
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimiçi   Alıntı Yaparak Cevapla
Eski 04-11-2014, 12:23   #4
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Teşekkürler Hüseyin Bey, ellerinize sağlık. İstediğim gibi olmuş.
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2014, 15:14   #5
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Hüseyin Beu merhaba,

Yazdığınız kodla ilgili bir sorum olacak. Kod anladığım kadarı ile veri sayfasındaki Ürün Kodu sütunu verilerini benzersiz değerlere dönüştürüp ondan sonra toplama işlemini yaptırmakta. Düşündüğüm gibiyse bu benzersiz değerlere dönüştüren kodun nerde yazdığını anlamış değilim.

Ya da kodun çalışma mantığını kısaca açıklayabilir misiniz.

Teşekkürler,
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2014, 23:24   #6
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,583
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

"For...." ile başlayan satırın altındaki sorgu satırı benzersiz liste oluşmasını sağlıyor. Döngüye alınan veriler saydırılıyor. Sayım sonucu 1 ise işleme devam ediliyor.
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2014, 07:09   #7
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Teşekkürler Korhan Bey,
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2014, 07:52   #8
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,553
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Açıklamasını hazırlamıştım ancak şirket bilgisayarımda kalmıştı.

Şimdi yayınlayabiliyorum.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub KOD()
    Application.ScreenUpdating = False
    ' ekran haraketlerini dondur
    
    Dim SV As Worksheet: Set SV = Sheets("Veri")
    Dim ST As Worksheet: Set ST = Sheets("Tablo")
    'sayfa isimlerine değişken atama
    
    ST.Range("A2:D" & Rows.Count).ClearContents
    'tablo sayfasını temizle
    
    sat = 2
    'tablo sayfasında başlangıç satırımız
    
    For i = 2 To SV.Cells(Rows.Count, "B").End(3).Row '(döngü)
    'veri sayfası B sütununda 2.satırdan son dolu satıra kadar kontrol başlıyor
    
        If WorksheetFunction.CountIf(SV.Range("B2:B" & i), SV.Cells(i, "B")) = 1 Then
        ' veri sayfasında B2:B2 - B2:B3 - B2:B4 diye devam ederek
        ' sırayla ürün kodlarını kontrol ediyoruz. ilk kez geçen ürün kodunu alıyoruz. (eğersay=CountIf)
        ' bu şekilde teke düşürüyoruz
        
            ST.Cells(sat, "A") = SV.Cells(i, "B")
            ' ilk önce bulunan ürün kodunu tablo sayfasına alıyoruz
            
            ST.Cells(sat, "B") = SV.Cells(i, "C")
            ' ürün ismini alıyoruz
            
            ST.Cells(sat, "C") = WorksheetFunction.SumIf(SV.Range("B:B"), SV.Cells(i, "B"), SV.Range("E:E"))
            'SumIf - Etopla Ürünün miktar toplamını aldırıyoruz
            
            ST.Cells(sat, "D") = WorksheetFunction.SumIf(SV.Range("B:B"), SV.Cells(i, "B"), SV.Range("F:F"))
            ' ürünün tutar toplamını aldırıyoruz
            
            sat = sat + 1
            ' tablo sayfasında bir sonraki üründe bir alt satıra geçmesini sağlıyoruz
            
        End If
        ' eğersay şartı bitiyor
        
    Next i
    ' döngü sonu
    
    
    Application.ScreenUpdating = True
    ' ekran haraketlerini aç
    
    MsgBox " B i t t i "
    ' uyarı
End Sub
. . .
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
http://www.excel.web.tr/f59/rnek-dosya-hazyrlarken-dikkat-edilmesi-gerekenler-t134225.html
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimiçi   Alıntı Yaparak Cevapla
Eski 05-11-2014, 14:59   #9
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Hüseyin bey çok teşekkürler, şahsım adıma çok iyi bir uygulama görmüş oldum.
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-11-2014, 08:46   #10
walabi
Altın Üye
 
Giriş: 22/09/2012
Şehir: istanbul
Mesaj: 161
Excel Vers. ve Dili:
excel 2010 excel 2013
Varsayılan

Merhaba,

Daha önce açtığım bu konu ile ilgili ek bir sorum olacak. İlgili örnek dosyanın miktar ve tutar sütunlarının altına dip toplamı nasıl aldırabilirim , makro ile. Bir de mümkünse alt toplam oluşturmak istiyorum.
__________________
52,5 oney ünye
walabi Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 08:15


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden