• DİKKAT

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

Makro ile veri aktarma

  • Konbuyu başlatan Konbuyu başlatan mbldn
  • Başlangıç tarihi Başlangıç tarihi
M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
Arkadaşlar ve sevgili hocalarım merhabalar;
ekteki dosyamda içinden çıkamadığım şudur ki; bir özet sayfam var bu sayfada bir açılır kutu ve açılan kutu listesinde aylar var. açılan kutudan aylar seçildiğinde, diğer sayfalardan verileri alıp bu özet sayfaya getirecek. her yıl için ayrı bir sayfa var ben iki sayfayı sayın husgvarna hocamın kodlarını değiştirerek yaptım ama üçüncü dördüncü sayfa işin içine girince bende elektrikler kesildi.
yardımcı olabilecek arkadaşlara çok teşekkür ederim. dosyam ektedir.
saygılar.
(bu arada sorun yaşadığım özellikli konu da şudur: diyelik ki 2005 te bir ile satış yok ama 2006 da var 2007 yok 2008 var var olanları var yok olanları da boş gösterecek bilhassa buna takıldım.)
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodları dener misiniz?

Kod: 
Private Sub ComboBox1_Change()
    Dim Syf     As Worksheet, _
        Bul     As Range, _
        Adr     As String, _
        d       As Object, _
        k       As Integer, _
        Deger   As Variant, _
        Dizi()  As Variant, _
        i       As Integer, _
        j       As Integer, _
        Liste
    
    ReDim Dizi(Sheets.Count - 1)
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 5 Then i = 5
    Range("B5:M" & i).ClearContents
    
    k = 9999
    
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            If Syf.Name < k Then k = Syf.Name
        End If
    Next Syf
    
    k = k - 1 'En Küçük Yıl Kodu
    
    Set d = CreateObject("Scripting.Dictionary")
    
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            With Syf.Range("A:A")
                Set Bul = .Find(ComboBox1.Value, LookIn:=xlValues)
                If Not Bul Is Nothing Then
                    Adr = Bul.Address
                    Do
                        Deger = Syf.Cells(Bul.Row, "B") & "|" & Syf.Cells(Bul.Row, "A")
                        If Not d.exists(Deger) Then
                            ReDim Dizi(Sheets.Count - 1)
                            Dizi(0) = Syf.Cells(Bul.Row, "B")
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Add Deger, Dizi
                        Else
                            Dizi = d.Item(Deger)
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Item(Deger) = Dizi
                        End If
                        Set Bul = .FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adr
                End If
            End With
        End If
    Next Syf
    Liste = d.items
    For i = 0 To UBound(Liste)
        Dizi = Liste(i)
        Range("B" & i + 5).Resize(1, UBound(Dizi)) = Dizi
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
 

Ekli dosyalar

Sayın Hocam;
çok teşekkür ederim. çok değişik yollar denemiş ama başaramamıştım. yeni bir şey daha öğrenmiş oldum sayenizde.
saygılar sevgiler



Necdet Yeşertener' Alıntı:
Merhaba,

Aşağıdaki kodları dener misiniz?

Kod: 
Private Sub ComboBox1_Change()
    Dim Syf     As Worksheet, _
        Bul     As Range, _
        Adr     As String, _
        d       As Object, _
        k       As Integer, _
        Deger   As Variant, _
        Dizi()  As Variant, _
        i       As Integer, _
        j       As Integer, _
        Liste
    
    ReDim Dizi(Sheets.Count - 1)
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 5 Then i = 5
    Range("B5:M" & i).ClearContents
    
    k = 9999
    
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            If Syf.Name < k Then k = Syf.Name
        End If
    Next Syf
    
    k = k - 1 'En Küçük Yıl Kodu
    
    Set d = CreateObject("Scripting.Dictionary")
    
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            With Syf.Range("A:A")
                Set Bul = .Find(ComboBox1.Value, LookIn:=xlValues)
                If Not Bul Is Nothing Then
                    Adr = Bul.Address
                    Do
                        Deger = Syf.Cells(Bul.Row, "B") & "|" & Syf.Cells(Bul.Row, "A")
                        If Not d.exists(Deger) Then
                            ReDim Dizi(Sheets.Count - 1)
                            Dizi(0) = Syf.Cells(Bul.Row, "B")
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Add Deger, Dizi
                        Else
                            Dizi = d.Item(Deger)
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Item(Deger) = Dizi
                        End If
                        Set Bul = .FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adr
                End If
            End With
        End If
    Next Syf
    Liste = d.items
    For i = 0 To UBound(Liste)
        Dizi = Liste(i)
        Range("B" & i + 5).Resize(1, UBound(Dizi)) = Dizi
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub
Genişletmek için tıkla ...
 
Merhaba,

Güle güle kullanınız. Saygı bizden.
 
Sayın Hocam;
tekrar rahatsız ediyorum, küçük bir husus daha vardı. açılır kutudan ayları seçtiğimizde ilgili veriler çok güzel geliyor fakat açılan kutuya "tümü" ilavesi yapsak yılların il bazında kümülatif toplamlarını özet sayfaya yazdırmak için "tümü" kısmını nasıl düzenleyebilirim. yol gösterebilir misiniz?


Necdet Yeşertener' Alıntı:
Merhaba,

Güle güle kullanınız. Saygı bizden.
Genişletmek için tıkla ...
 
mbldn' Alıntı:
Sayın Hocam;
tekrar rahatsız ediyorum, küçük bir husus daha vardı. açılır kutudan ayları seçtiğimizde ilgili veriler çok güzel geliyor fakat açılan kutuya "tümü" ilavesi yapsak yılların il bazında kümülatif toplamlarını özet sayfaya yazdırmak için "tümü" kısmını nasıl düzenleyebilirim. yol gösterebilir misiniz?
Genişletmek için tıkla ...

Merhaba,

Kodlardaki değişikliği kırmızı olarak işaretledim. Herhangi bir ay yerine boş bir seçim yapılırsa il bazında toplamlar alınır.

Kod: 
Private Sub ComboBox1_Change()
    Dim Syf     As Worksheet, _
        Bul     As Range, _
        Adr     As String, _
        d       As Object, _
        k       As Integer, _
        Deger   As Variant, _
        Dizi()  As Variant, _
        i       As Integer, _
        j       As Integer, _
        [B][COLOR=red]Aranan  As String[/COLOR][/B], _
        Liste
 
[COLOR=red][B]  If ComboBox1.ListIndex = 0 Then[/B][/COLOR]
[B][COLOR=red]      Aranan = "*"[/COLOR][/B]
[B][COLOR=red]  Else[/COLOR][/B]
[B][COLOR=red]      Aranan = ComboBox1.Value[/COLOR][/B]
[B][COLOR=red]  End If[/COLOR][/B]
 
    ReDim Dizi(Sheets.Count - 1)
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 5 Then i = 5
    Range("B5:M" & i).ClearContents
 
    k = 9999
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            If Syf.Name < k Then k = Syf.Name
        End If
    Next Syf
 
    k = k - 1 'En Küçük Yıl Kodu
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            With Syf.Range("A:A")
                Set Bul = .Find(Aranan, LookIn:=xlValues)
                If Not Bul Is Nothing Then
                    Adr = Bul.Address
                    Do
                        Deger = Syf.Cells(Bul.Row, "B") & "|" & [COLOR=red][B]Aranan[/B][/COLOR]
                        If Not d.exists(Deger) Then
                            ReDim Dizi(Sheets.Count - 1)
                            Dizi(0) = Syf.Cells(Bul.Row, "B")
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Add Deger, Dizi
                        Else
                            Dizi = d.Item(Deger)
                            Dizi(Syf.Name - k) =[B][COLOR=red] Dizi(Syf.Name - k) +[/COLOR][/B] Syf.Cells(Bul.Row, "C")
                            d.Item(Deger) = Dizi
                        End If
                        Set Bul = .FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adr
                End If
            End With
        End If
    Next Syf
    Liste = d.items
    For i = 0 To UBound(Liste)
        Dizi = Liste(i)
        Range("B" & i + 5).Resize(1, UBound(Dizi)) = Dizi
    Next i
 
    Application.ScreenUpdating = True
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
 

Ekli dosyalar

Sayın Hocam çok çok teşekkürler elinize sağlık

Necdet Yeşertener' Alıntı:
Merhaba,

Kodlardaki değişikliği kırmızı olarak işaretledim. Herhangi bir ay yerine boş bir seçim yapılırsa il bazında toplamlar alınır.

Kod: 
Private Sub ComboBox1_Change()
    Dim Syf     As Worksheet, _
        Bul     As Range, _
        Adr     As String, _
        d       As Object, _
        k       As Integer, _
        Deger   As Variant, _
        Dizi()  As Variant, _
        i       As Integer, _
        j       As Integer, _
        [B][COLOR=red]Aranan  As String[/COLOR][/B], _
        Liste
 
[COLOR=red][B]  If ComboBox1.ListIndex = 0 Then[/B][/COLOR]
[B][COLOR=red]      Aranan = "*"[/COLOR][/B]
[B][COLOR=red]  Else[/COLOR][/B]
[B][COLOR=red]      Aranan = ComboBox1.Value[/COLOR][/B]
[B][COLOR=red]  End If[/COLOR][/B]
 
    ReDim Dizi(Sheets.Count - 1)
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 5 Then i = 5
    Range("B5:M" & i).ClearContents
 
    k = 9999
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            If Syf.Name < k Then k = Syf.Name
        End If
    Next Syf
 
    k = k - 1 'En Küçük Yıl Kodu
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            With Syf.Range("A:A")
                Set Bul = .Find(Aranan, LookIn:=xlValues)
                If Not Bul Is Nothing Then
                    Adr = Bul.Address
                    Do
                        Deger = Syf.Cells(Bul.Row, "B") & "|" & [COLOR=red][B]Aranan[/B][/COLOR]
                        If Not d.exists(Deger) Then
                            ReDim Dizi(Sheets.Count - 1)
                            Dizi(0) = Syf.Cells(Bul.Row, "B")
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Add Deger, Dizi
                        Else
                            Dizi = d.Item(Deger)
                            Dizi(Syf.Name - k) =[B][COLOR=red] Dizi(Syf.Name - k) +[/COLOR][/B] Syf.Cells(Bul.Row, "C")
                            d.Item(Deger) = Dizi
                        End If
                        Set Bul = .FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adr
                End If
            End With
        End If
    Next Syf
    Liste = d.items
    For i = 0 To UBound(Liste)
        Dizi = Liste(i)
        Range("B" & i + 5).Resize(1, UBound(Dizi)) = Dizi
    Next i
 
    Application.ScreenUpdating = True
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
Genişletmek için tıkla ...
 
Necdet Yeşertener' Alıntı:
Merhaba,

Kodlardaki değişikliği kırmızı olarak işaretledim. Herhangi bir ay yerine boş bir seçim yapılırsa il bazında toplamlar alınır.

Kod: 
Private Sub ComboBox1_Change()
    Dim Syf     As Worksheet, _
        Bul     As Range, _
        Adr     As String, _
        d       As Object, _
        k       As Integer, _
        Deger   As Variant, _
        Dizi()  As Variant, _
        i       As Integer, _
        j       As Integer, _
        [B][COLOR=red]Aranan  As String[/COLOR][/B], _
        Liste
 
[COLOR=red][B]  If ComboBox1.ListIndex = 0 Then[/B][/COLOR]
[B][COLOR=red]      Aranan = "*"[/COLOR][/B]
[B][COLOR=red]  Else[/COLOR][/B]
[B][COLOR=red]      Aranan = ComboBox1.Value[/COLOR][/B]
[B][COLOR=red]  End If[/COLOR][/B]
 
    ReDim Dizi(Sheets.Count - 1)
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 5 Then i = 5
    Range("B5:M" & i).ClearContents
 
    k = 9999
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            If Syf.Name < k Then k = Syf.Name
        End If
    Next Syf
 
    k = k - 1 'En Küçük Yıl Kodu
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For Each Syf In Worksheets
        If Not Syf.Name = "ozet" Then
            With Syf.Range("A:A")
                Set Bul = .Find(Aranan, LookIn:=xlValues)
                If Not Bul Is Nothing Then
                    Adr = Bul.Address
                    Do
                        Deger = Syf.Cells(Bul.Row, "B") & "|" & [COLOR=red][B]Aranan[/B][/COLOR]
                        If Not d.exists(Deger) Then
                            ReDim Dizi(Sheets.Count - 1)
                            Dizi(0) = Syf.Cells(Bul.Row, "B")
                            Dizi(Syf.Name - k) = Syf.Cells(Bul.Row, "C")
                            d.Add Deger, Dizi
                        Else
                            Dizi = d.Item(Deger)
                            Dizi(Syf.Name - k) =[B][COLOR=red] Dizi(Syf.Name - k) +[/COLOR][/B] Syf.Cells(Bul.Row, "C")
                            d.Item(Deger) = Dizi
                        End If
                        Set Bul = .FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adr
                End If
            End With
        End If
    Next Syf
    Liste = d.items
    For i = 0 To UBound(Liste)
        Dizi = Liste(i)
        Range("B" & i + 5).Resize(1, UBound(Dizi)) = Dizi
    Next i
 
    Application.ScreenUpdating = True
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
Genişletmek için tıkla ...

Sayın Hocam Merhaba;
daha önce yapmış olduğunuz bu kodlamada revizyona gitme ihtiyacım hasıl oldu. şöyleki yıl sayfalarından veriler açılır kutudan seçilen değere göre yan yana geliyordu. diğer sayfalardan yalnızca b sütutundan gelen hücreleri sabit yapıp diğer veriler yan yana diziliyordu. şimdi b sütunun yanına bir sütun eklemem gerekti. kodda nasıl bir değişiklik yaparsam b ve c sütunu sabit ve metin yan yana da satış rakamları gelsin?
saygılar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst