• DİKKAT

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

VERİ AMBARINDAN ÇEKİLEN RAPORU BELLİ FORMAT'TA TABLOLARA DÖNÜŞTÜRME

ensar1453

ensar1453

Katılım
22 Şubat 2018
Mesajlar
34
Excel Vers. ve Dili
Excel 2013 - Türkçe
MERHABALAR ÜSTADLARIM HEP YAPMAK İSTEDİĞİM BİR PROJE VAR FAKAT BİR TÜRLÜ BECEREMİYORUM VE MANUEL OLARAK YAPMAK ZORUNDA KALIYORUM. SİZDEN RİCAM ŞUDUR. EKTEKİ DOSYADA 1. SAYFADA ÇEKİLEN RAPOR VAR (HALİYLE ASIL RAPORUM BU KADAR KISA DEĞİL BİNLERCE SUTUN VAR) BİR MAKRO YARDIMI İLE 2. SAYFADAKİ DİZİLİME DÖNÜŞTÜRMEK İSTİYORUM. YARDIMCI OLABİLİRSENİZ ÇOK SEVİNİRİM. TEŞEKKÜRLER.
 

Ekli dosyalar

Merhaba

Tablonuzu inceledim fakat diğer sayfaya aktarma mantığını çözemedim.
Birkaç cümleyle açıklama yazsanız iyi olur.

Selamlar...
 
kulomer46' Alıntı:
Merhaba

Tablonuzu inceledim fakat diğer sayfaya aktarma mantığını çözemedim.
Birkaç cümleyle açıklama yazsanız iyi olur.

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

Merhabalar ilginiz için teşekkür ederim,
Ekte görüldüğü üzere çeşitli müdürlükler var ve bunların faaliyet bilgileri var.
Benim isteğim birinci sayfada olan verileri ikinci sayfada müdürlük ismi başlık olacak altında sıralı şekilde bilgileri olacak,
Yani şöyle düşünün 2. sayfa hiç yok sadece 1. sayfa var ve yazdığım makroyu çalıştırdığımda bana 2. sayfayı oluşturacak.
 
Aşağıdaki makroyu dener misiniz? Yalnız önce 1. SAYFA'nın adını Veri ve 2. SAYFA'nın adını da Rapor olarak değiştirmeniz gerekiyor.
PHP: 
Sub duzenle()
Set s1 = Sheets("Veri")
Set s2 = Sheets("Rapor")

s2.[A:H].Clear
s2.Range("A1:H1").Merge
s2.[A1] = s1.[A2]
s2.[A1].Font.Bold = True
s2.Range("A2:H2").Interior.ThemeColor = xlThemeColorAccent1
s2.Range("A2:H2").Font.Color = vbWhite
s2.Range("A2:H2").Font.Bold = True
s2.Range("A2:H2").HorizontalAlignment = xlCenter
s2.[A2] = "SIRA NO"
s2.[B2] = "AMAÇ - HEDEF"
s2.[C2] = "FAALİYET KODU"
s2.[D2] = "FAALİYET ADI"
s2.[E2] = "UYUGLAMA YERİ"
s2.[F2] = "TEMA"
s2.[G2] = "BİTİŞ YILI"
s2.[H2] = "2020 TUTARI (BİN TL)"


son = s1.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
    If WorksheetFunction.CountIf(s1.Range("A1:A" & i), s1.Cells(i, "A")) = 1 Then
        
        If s2.[A3] <> "" Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 2
            s2.[A1:H2].Copy s2.Cells(yeni, "A")
            Cells(yeni, "A") = s1.Cells(i, "A")
        End If
        
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
        
        Set con = VBA.CreateObject("adodb.Connection")
        
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
        
        sorgu = "select [STRATEJİK HEDEF],[FAALİYET KODU],[FAALİYET ADI],[UYGULAMA YERİ],TEMA,[BİTİRME YILI],[2020 BÜTÇE]" & _
        "from[Veri$] where [MÜDÜRLÜK] = '" & s1.Cells(i, "A") & "'"
    
        Set rs = con.Execute(sorgu)
        s2.Cells(yeni, "B").CopyFromRecordset rs
        
        yeniB = s2.Cells(Rows.Count, "B").End(3).Row
        For j = yeni To yeniB
            s2.Cells(j, "A") = j - yeni + 1
        Next
        s2.Range("A" & yeni - 1 & ":A" & yeniB).HorizontalAlignment = xlCenter
        s2.Range("F" & yeni - 1 & ":G" & yeniB).HorizontalAlignment = xlCenter

        s2.Range("A" & yeni - 1 & ":H" & yeniB).Borders.LineStyle = 1
    End If
Next
s2.Cells.EntireColumn.AutoFit
s2.Range("H3:H" & yeniB).NumberFormat = "#,##0_ ;-#,##0 "
s2.Range("A1:H" & yeniB).VerticalAlignment = xlCenter

End Sub
 
YUSUF44' Alıntı:
Aşağıdaki makroyu dener misiniz? Yalnız önce 1. SAYFA'nın adını Veri ve 2. SAYFA'nın adını da Rapor olarak değiştirmeniz gerekiyor.
PHP: 
Sub duzenle()
Set s1 = Sheets("Veri")
Set s2 = Sheets("Rapor")

s2.[A:H].Clear
s2.Range("A1:H1").Merge
s2.[A1] = s1.[A2]
s2.[A1].Font.Bold = True
s2.Range("A2:H2").Interior.ThemeColor = xlThemeColorAccent1
s2.Range("A2:H2").Font.Color = vbWhite
s2.Range("A2:H2").Font.Bold = True
s2.Range("A2:H2").HorizontalAlignment = xlCenter
s2.[A2] = "SIRA NO"
s2.[B2] = "AMAÇ - HEDEF"
s2.[C2] = "FAALİYET KODU"
s2.[D2] = "FAALİYET ADI"
s2.[E2] = "UYUGLAMA YERİ"
s2.[F2] = "TEMA"
s2.[G2] = "BİTİŞ YILI"
s2.[H2] = "2020 TUTARI (BİN TL)"


son = s1.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
    If WorksheetFunction.CountIf(s1.Range("A1:A" & i), s1.Cells(i, "A")) = 1 Then
       
        If s2.[A3] <> "" Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 2
            s2.[A1:H2].Copy s2.Cells(yeni, "A")
            Cells(yeni, "A") = s1.Cells(i, "A")
        End If
       
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
       
        Set con = VBA.CreateObject("adodb.Connection")
       
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
       
        sorgu = "select [STRATEJİK HEDEF],[FAALİYET KODU],[FAALİYET ADI],[UYGULAMA YERİ],TEMA,[BİTİRME YILI],[2020 BÜTÇE]" & _
        "from[Veri$] where [MÜDÜRLÜK] = '" & s1.Cells(i, "A") & "'"
   
        Set rs = con.Execute(sorgu)
        s2.Cells(yeni, "B").CopyFromRecordset rs
       
        yeniB = s2.Cells(Rows.Count, "B").End(3).Row
        For j = yeni To yeniB
            s2.Cells(j, "A") = j - yeni + 1
        Next
        s2.Range("A" & yeni - 1 & ":A" & yeniB).HorizontalAlignment = xlCenter
        s2.Range("F" & yeni - 1 & ":G" & yeniB).HorizontalAlignment = xlCenter

        s2.Range("A" & yeni - 1 & ":H" & yeniB).Borders.LineStyle = 1
    End If
Next
s2.Cells.EntireColumn.AutoFit
s2.Range("H3:H" & yeniB).NumberFormat = "#,##0_ ;-#,##0 "
s2.Range("A1:H" & yeniB).VerticalAlignment = xlCenter

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

ÜSTADIM ÇOK TEŞEKKÜR EDERİM BU HIZINIZA GERÇEKTEN HAYRANIM ŞUAN TEK GÖRDÜĞÜM EKSİK 2. SAYFADA TÜM MÜDÜRLÜK İSİMLERİNİ M1 OLARAK ATIYOR ONU NASIL ÇÖZEBİLİRİM ?
 
YUSUF44' Alıntı:
Aşağıdaki makroyu dener misiniz? Yalnız önce 1. SAYFA'nın adını Veri ve 2. SAYFA'nın adını da Rapor olarak değiştirmeniz gerekiyor.
PHP: 
Sub duzenle()
Set s1 = Sheets("Veri")
Set s2 = Sheets("Rapor")

s2.[A:H].Clear
s2.Range("A1:H1").Merge
s2.[A1] = s1.[A2]
s2.[A1].Font.Bold = True
s2.Range("A2:H2").Interior.ThemeColor = xlThemeColorAccent1
s2.Range("A2:H2").Font.Color = vbWhite
s2.Range("A2:H2").Font.Bold = True
s2.Range("A2:H2").HorizontalAlignment = xlCenter
s2.[A2] = "SIRA NO"
s2.[B2] = "AMAÇ - HEDEF"
s2.[C2] = "FAALİYET KODU"
s2.[D2] = "FAALİYET ADI"
s2.[E2] = "UYUGLAMA YERİ"
s2.[F2] = "TEMA"
s2.[G2] = "BİTİŞ YILI"
s2.[H2] = "2020 TUTARI (BİN TL)"


son = s1.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
    If WorksheetFunction.CountIf(s1.Range("A1:A" & i), s1.Cells(i, "A")) = 1 Then
       
        If s2.[A3] <> "" Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 2
            s2.[A1:H2].Copy s2.Cells(yeni, "A")
            Cells(yeni, "A") = s1.Cells(i, "A")
        End If
       
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
       
        Set con = VBA.CreateObject("adodb.Connection")
       
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
       
        sorgu = "select [STRATEJİK HEDEF],[FAALİYET KODU],[FAALİYET ADI],[UYGULAMA YERİ],TEMA,[BİTİRME YILI],[2020 BÜTÇE]" & _
        "from[Veri$] where [MÜDÜRLÜK] = '" & s1.Cells(i, "A") & "'"
   
        Set rs = con.Execute(sorgu)
        s2.Cells(yeni, "B").CopyFromRecordset rs
       
        yeniB = s2.Cells(Rows.Count, "B").End(3).Row
        For j = yeni To yeniB
            s2.Cells(j, "A") = j - yeni + 1
        Next
        s2.Range("A" & yeni - 1 & ":A" & yeniB).HorizontalAlignment = xlCenter
        s2.Range("F" & yeni - 1 & ":G" & yeniB).HorizontalAlignment = xlCenter

        s2.Range("A" & yeni - 1 & ":H" & yeniB).Borders.LineStyle = 1
    End If
Next
s2.Cells.EntireColumn.AutoFit
s2.Range("H3:H" & yeniB).NumberFormat = "#,##0_ ;-#,##0 "
s2.Range("A1:H" & yeniB).VerticalAlignment = xlCenter

End Sub
Genişletmek için tıkla ...
üstadım 2 problemim de şu ki bu kodları 550 sütunluk bir veri dosyasına aldığımda aşığıdaki hatayı alıyorum.
214509
 
ensar1453' Alıntı:
ÜSTADIM ÇOK TEŞEKKÜR EDERİM BU HIZINIZA GERÇEKTEN HAYRANIM ŞUAN TEK GÖRDÜĞÜM EKSİK 2. SAYFADA TÜM MÜDÜRLÜK İSİMLERİNİ M1 OLARAK ATIYOR ONU NASIL ÇÖZEBİLİRİM ?
Genişletmek için tıkla ...
Benim aldığım sonuç bu şekilde:

214511

Sonraki belirttiğiniz hata için yorum yapamayacağım. Aynı yapıda olan verilerde sorun çıkmaması lazım, çok daha fazla veride bile doğru sonuç verir diye biliyorum.
 
Koda renklendirme de ekledim. Ekli dosyayı inceleyiniz. 2160 satırda sorunsuz çalıştı:
 

Ekli dosyalar

Exceli şöyle profesyonelce kullananlara bayılıyorum ya. Bir gün bizde acaba sizin seviyenize çıkabilecek miyiz Sayın @YUSUF44

Saygılar.
 
Nezaketiniz için teşekkür ederim.

Ancak kendimi seviye olarak o kadar ilerde görmüyorum. Yapamadığım o kadar çok şey var ki! Örneğin dizi formülleri, grafikler, makroyla dizi yöntemiyle veri özetleme ve daha niceleri.

Bu sitede @İdris SERDAR , @Haluk , @Ömer, @Korhan Ayhan, @muygun, @Murat OSMA, @çıtır, @Orion1 ve ismini sayamadığım daha nice üstadın yanında, benim bildiğim devede kulak bile değil. Naçizane elimden geldiğince forumdaşlara yardımcı olmaya ve bu sırada da yeni şeyler öğrenmeye gayret ediyorum. Hep birlikte gelişiyoruz.

Örneğin bu konuda sunduğum çözümde sql ile veri süzme var. Bunu ben son bir senede bu sitede gördüm ve kullanmaya başladım. Ama yöntemini ezbere bilmiyorum, kopyala yapıştır yapıyorum. Hatta dün kodu çalışır hale getirinceye kadar epey uğraştım, sorgu sonunda ' işaretini kullanmadığım için bir türlü çalıştıramadım. Eğer bu yöntemi kullanmasaydım klasik döngü yöntemini kullanacaktım ve bu da makronun çalışma süresini belki 10 belki de daha fazla kat arttıracaktı.
 
YUSUF44' Alıntı:
Nezaketiniz için teşekkür ederim.

Ancak kendimi seviye olarak o kadar ilerde görmüyorum. Yapamadığım o kadar çok şey var ki! Örneğin dizi formülleri, grafikler, makroyla dizi yöntemiyle veri özetleme ve daha niceleri.

Bu sitede @İdris SERDAR , @Haluk , @Ömer, @Korhan Ayhan, @muygun, @Murat OSMA, @çıtır, @Orion1 ve ismini sayamadığım daha nice üstadın yanında, benim bildiğim devede kulak bile değil. Naçizane elimden geldiğince forumdaşlara yardımcı olmaya ve bu sırada da yeni şeyler öğrenmeye gayret ediyorum. Hep birlikte gelişiyoruz.

Örneğin bu konuda sunduğum çözümde sql ile veri süzme var. Bunu ben son bir senede bu sitede gördüm ve kullanmaya başladım. Ama yöntemini ezbere bilmiyorum, kopyala yapıştır yapıyorum. Hatta dün kodu çalışır hale getirinceye kadar epey uğraştım, sorgu sonunda ' işaretini kullanmadığım için bir türlü çalıştıramadım. Eğer bu yöntemi kullanmasaydım klasik döngü yöntemini kullanacaktım ve bu da makronun çalışma süresini belki 10 belki de daha fazla kat arttıracaktı.
Genişletmek için tıkla ...

ÜSTADIM ZATEN MAKRONUN ÇALIŞMA HIZINA ŞOK OLDUK BİZ BUNA BENZER BİR MAKRO YAZMIŞTIK AMA İNANIN MAKRONUN ÇALIŞMASI 10 DAKİKAYA YAKIN SÜRÜYORDU VE ÇOĞU ZAMAN BİLGİSAYAR KASIYORDU HER AN PATLIYACAK DİYE KORKUYORDUK SİZİN KODLAR İLE 5 SANİYEDE TERTEMİZ SONUÇLAR ALIYORUZ. NE KADAR TEŞEKKÜR ETSEK AZ UMARIM BİZDE SİZLER GİBİ KENDİMİZİ GELİŞTİREBİLİRİZ VE BAŞKA ARKADAŞLARA YARDIMCI OLABİLİRİZ. SAYGILARIMLA.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst