Formüllü sayfaları makroya çevirmek

izcik · 27 Temmuz 2021

Merhaba

ornek1 adlı dosyada, formüllerin bulunduğu iki adet sayfa var. Bu iki saydadaki formüllerin makroya çevirilmesini rica ederim.

Sebebi de şudur; formüller güzel fakat, satırlar 3000-4000 satır olduğunda, sadece F sütununun işlemi yapması bile yarım saatten fazla sürüyor.

Ayrıca örnek2 dosyasını da numune olarak gönderiyorum. Bu dosyadaki makroları sayın Korhan Ayhan uzmanım yapmıştı.

Örnek1’deki sayfalar da, örnek 2 gibi olursa çok iyi olur. Teşekkürler.

örnek1 (yapılması gereken)

ornek1.xlsx dosyasını indir - download

ornek1.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Örnek2 (Korhan Ayhan uzmanımın daha önce yaptığı numune)

ornek2.xlsm dosyasını indir - download

ornek2.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

Korhan Ayhan · 28 Temmuz 2021

Merhaba,

Örnek dosyayı inceleyiniz. Formüllü alanları bilerek silmedim. Böylece sonuçları kontrol edebilirsiniz.

Harici Link (Silinebilir) ; https://dosyam.org/1OqD/Örnek_1_Pivot.xlsm

izcik · 28 Temmuz 2021

Uzmanım emeğinize sağlık, merak ve hevesle hemen indirdim. Neticeyi arz edeceğim.

izcik · 28 Temmuz 2021

Korhan Ayhan' Alıntı:
Merhaba,

Örnek dosyayı inceleyiniz. Formüllü alanları bilerek silmedim. Böylece sonuçları kontrol edebilirsiniz.

Harici Link (Silinebilir) ; https://dosyam.org/1OqD/Örnek_1_Pivot.xlsm

Sayın uzmanım şahane olmuş şahane. İnceliyorum.

izcik · 28 Temmuz 2021

Uzmanım bir minik soru arz edeceğim;
Örnek; ben fıormüllerdeki 2000 sayılarını (gerektiğinde) 6500 olarak değiştiriyordum. Makrolu dosyamız da 2000 satır için mi geçerlidir yoksa sayfanın sonuna kadar mı geçerlidir?

Korhan Ayhan · 28 Temmuz 2021

Deneme yaparak sonucu görebilirsiniz.

izcik · 28 Temmuz 2021

Sayın Uzmanım konu hazır tazeyken size bir dosya daha arz edeyim.

Sütunları ve satırları tersine aktarma.

(Fakat B’den G’ye kadar olan sütunlar değişebilir)
Bazen B’den E’ye kadar olabilir,
Bazen B’den J’ye kadar olabilir.

Saygılar

ornek.xlsx dosyasını indir - download

ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

Korhan Ayhan · 28 Temmuz 2021

Aradığınız işlem kopyala-özel yapıştır-işlemi tersine çevir özelliğidir.

Makro kaydet yöntemi ile elde ettiğim kodları biraz düzenledim.

C++:

Option Explicit

Sub Transpose_Aktar()
    Application.ScreenUpdating = False
    
    Range("K:XFD").Clear
    Range("A1").CurrentRegion.Copy
    Range("K1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Application.CutCopyMode = False
    Range("A1").Select
    Columns.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

izcik · 28 Temmuz 2021

Korhan Ayhan' Alıntı:
Aradığınız işlem kopyala-özel yapıştır-işlemi tersine çevir özelliğidir.

Makro kaydet yöntemi ile elde ettiğim kodları biraz düzenledim.

C++:

Option Explicit Sub Transpose_Aktar() Application.ScreenUpdating = False Range("K:XFD").Clear Range("A1").CurrentRegion.Copy Range("K1").PasteSpecial Paste:=xlPasteAll, Transpose:=True Application.CutCopyMode = False Range("A1").Select Columns.AutoFit Application.ScreenUpdating = True MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub

Uzmanım sağ olunuz. Hemen inceliyorum.

izcik · 28 Temmuz 2021

Korhan Ayhan' Alıntı:
Aradığınız işlem kopyala-özel yapıştır-işlemi tersine çevir özelliğidir.

Makro kaydet yöntemi ile elde ettiğim kodları biraz düzenledim.

C++:

Option Explicit Sub Transpose_Aktar() Application.ScreenUpdating = False Range("K:XFD").Clear Range("A1").CurrentRegion.Copy Range("K1").PasteSpecial Paste:=xlPasteAll, Transpose:=True Application.CutCopyMode = False Range("A1").Select Columns.AutoFit Application.ScreenUpdating = True MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub

Bravo

Korhan Ayhan · 28 Temmuz 2021

Bu da alternatif olsun.

Bir önceki kod kopyala-yapıştır metodu ile işlemi yapıyor. Aşağıda ki kod ise VBA komutları ile bu işlemi yapıyor.

C++:

Option Explicit

Sub Transpose_Aktar()
    Dim Alan As Range

    Application.ScreenUpdating = False
    
    Set Alan = Range("A1").CurrentRegion
    
    Range("K:XFD").Clear
    Range("K1").Resize(Alan.Columns.Count, Alan.Rows.Count).Value = Application.Transpose(Alan.Value)
    Columns.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

izcik · 28 Temmuz 2021

Korhan Ayhan' Alıntı:
Bu da alternatif olsun.

Bir önceki kod kopyala-yapıştır metodu ile işlemi yapıyor. Aşağıda ki kod ise VBA komutları ile bu işlemi yapıyor.

C++:

Option Explicit Sub Transpose_Aktar() Dim Alan As Range Application.ScreenUpdating = False Set Alan = Range("A1").CurrentRegion Range("K:XFD").Clear Range("K1").Resize(Alan.Columns.Count, Alan.Rows.Count).Value = Application.Transpose(Alan.Value) Columns.AutoFit Application.ScreenUpdating = True MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub

Uzmanım varolun; bilgisayar başına geçer geçmez hemen deneyeceğim.

Bir de çok küçük başka bir sorum olacak. Aslında şu an da arz edebilirim.

Hani upload sitesine yüklediğiniz dosyada, iki sayfada da düğmeye basınca “Toplam adetler” oluşuyor ya,
Kodlarda nereyi silersek bu adet sütunları iptal olur?
Deneme yanılmayla yapmaya çalıştım, olmadı

Korhan Ayhan · 29 Temmuz 2021

Kırmızı bölümü silerek deneyebilirsiniz.

Sorgu = "Transform Sum([ADETLER]) " & _
"Select [HANGİ DEPO], Sum([ADETLER]) As [TOPLAM ADET] From [C SÜTUNUNA GÖRE$] " & _
"Group By [HANGİ DEPO] Pivot [ÜRÜN KODU]"

izcik · 29 Temmuz 2021

Korhan Ayhan' Alıntı:
Kırmızı bölümü silerek deneyebilirsiniz.

Olmuştur Sayın Korhan Ayhan uzmanım, teşekkür ederim

izcik · 1 Ağustos 2021

Korhan Ayhan' Alıntı:
Merhaba,

Örnek dosyayı inceleyiniz. Formüllü alanları bilerek silmedim. Böylece sonuçları kontrol edebilirsiniz.

Harici Link (Silinebilir) ; https://dosyam.org/1OqD/Örnek_1_Pivot.xlsm

Sayın Korhan Ayhan uzmanım merhaba,

İki küçük hata ile karşılaştım ve arz etmek istedim.

Birinci sayfada düğmeye bastığımızda, oluşmaması gereken P sütunu oluşuyor; P1 hücresinde “küçük-büyük” işaretleri oluşuyor ve altında oluşmaması gereken bir boş satır oluşuyor. (N2-U2 arası)

İkinci sayfada ise düğmeye bastığımızda hata veriyor. Rica etsem düzeltebilir misiniz

Arz ederim

Saygılar.

https://s6.dosya.tc/server3/5w0icj/uzmanima_ornek.xlsm.html

Korhan Ayhan · 1 Ağustos 2021

"A SÜTUNUNA GÖRE" isimli sayfanız için sorgu satırını aşağıdaki gibi değiştirip kullanabilirsiniz.

C++:

    Sorgu = "Transform Sum([ADETLER]) " & _
            "Select [ÜRÜN KODU], Sum([ADETLER]) As [TOPLAM ADET] From [A SÜTUNUNA GÖRE$] Where Not IsNull([ÜRÜN KODU]) " & _
            "Group By [ÜRÜN KODU] Pivot [HANGİ DEPO]"

ADO ile 255 sütunluk veri derleyebilirsiniz. Daha fazla sütunluk veri varsa hata verecektir. Sizin "C SÜTUNUNA GÖRE" isimli sayfanızda 899 adet benzersiz ürün kodu bulunuyor.

izcik · 1 Ağustos 2021

Korhan Ayhan' Alıntı:
"A SÜTUNUNA GÖRE" isimli sayfanız için sorgu satırını aşağıdaki gibi değiştirip kullanabilirsiniz.

C++:

Sorgu = "Transform Sum([ADETLER]) " & _ "Select [ÜRÜN KODU], Sum([ADETLER]) As [TOPLAM ADET] From [A SÜTUNUNA GÖRE$] Where Not IsNull([ÜRÜN KODU]) " & _ "Group By [ÜRÜN KODU] Pivot [HANGİ DEPO]"

ADO ile 255 sütunluk veri derleyebilirsiniz. Daha fazla sütunluk veri varsa hata verecektir. Sizin "C SÜTUNUNA GÖRE" isimli sayfanızda 899 adet benzersiz ürün kodu bulunuyor.

Sayın uzmanım hemen denemeler yapıyorum

izcik · 1 Ağustos 2021

Korhan Ayhan' Alıntı:
"A SÜTUNUNA GÖRE" isimli sayfanız için sorgu satırını aşağıdaki gibi değiştirip kullanabilirsiniz.

C++:

Sorgu = "Transform Sum([ADETLER]) " & _ "Select [ÜRÜN KODU], Sum([ADETLER]) As [TOPLAM ADET] From [A SÜTUNUNA GÖRE$] Where Not IsNull([ÜRÜN KODU]) " & _ "Group By [ÜRÜN KODU] Pivot [HANGİ DEPO]"

ADO ile 255 sütunluk veri derleyebilirsiniz. Daha fazla sütunluk veri varsa hata verecektir. Sizin "C SÜTUNUNA GÖRE" isimli sayfanızda 899 adet benzersiz ürün kodu bulunuyor.

Sayın uzmanım denemelerimi yaptım; hemen arz edeyim.

“A SÜTUNUNA GÖRE” sayfasındaki Sorgu satırını verdiğiniz ile değiştirdim, düzeldi.

..

Aynı sorunun (boş satır oluşması ve <> işaretlerinin oluşması) “C SÜTUNUNA GÖRE” sayfasında da olduğunu farkettim.

Size zahmet olmazsa bu sayfanın da (C.S.G.) Sorgu satırını yazar mısınız?

Hemen örnek dosya arz ediyorum.

uzmanima_ornek2.xlsm dosyasını indir - download

uzmanima_ornek2.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

Korhan Ayhan · 1 Ağustos 2021

Deneyiniz.

C++:

    Sorgu = "Transform Sum([ADETLER]) " & _
            "Select [HANGİ DEPO], Sum([ADETLER]) As [TOPLAM ADET] From [C SÜTUNUNA GÖRE$] Where Not IsNull([HANGİ DEPO]) " & _
            "Group By [HANGİ DEPO] Pivot [ÜRÜN KODU]"

Korhan Ayhan · 1 Ağustos 2021

Ek olarak "C SÜTUNUNA GÖRE" sayfası için aşağıdaki kod ile excelin kendi özet tablosunu otomatik oluşturup kullanabilirsiniz.

Benim bilgisayarımda arada hata verdi. Ama dosyayı kaydedip tekrar çalıştırdığımda düzeliyor. Ya da dosyayı kapatıp açıp tekrar denediğimde hata vermiyor.

C++:

Option Explicit

Sub Pivot_Table()
    Dim S1 As Worksheet, Pivot_Data As Range
    Dim Pivot_Cache As PivotCaches
    Dim Pivot_Table As PivotTables, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("C SÜTUNUNA GÖRE")
    
    S1.Range("F:XFD").Clear
    
    Set Pivot_Data = S1.Range("A1").CurrentRegion
    
    On Error Resume Next
    
    Set Pivot_Cache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Pivot_Data). _
                      CreatePivotTable(TableDestination:=S1.Range("F1"), TableName:="Pivot_Table1")
    
    Set Pivot_Table = Pivot_Cache.CreatePivotTable(TableDestination:=S1.Range("A1"), TableName:="Pivot_Table1")
    
    On Error GoTo 0

    With S1.PivotTables("Pivot_Table1")
        .PivotFields("HANGİ DEPO").Orientation = xlRowField
        .PivotFields("HANGİ DEPO").Position = 1
        .AddDataField ActiveSheet.PivotTables("Pivot_Table1").PivotFields("ADETLER"), "Sum of ADETLER", xlSum
        .PivotFields("ÜRÜN KODU").Orientation = xlColumnField
        .PivotFields("ÜRÜN KODU").Position = 1
    End With
    
    S1.Range("F1").CurrentRegion.Offset(1).Copy
    S1.Range("F1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    S1.Range("F1") = "ÜRÜN KODU"
    S1.Range(S1.Range("F1"), S1.Range("F1").End(xlToRight)).Font.Bold = True
    S1.Range(S1.Range("F1"), S1.Range("F1").End(xlDown)).Font.Bold = True
    S1.Range(S1.Cells(S1.Rows.Count, "F").End(3), S1.Cells(S1.Rows.Count, "F").End(3).End(xlToRight)).Font.Bold = True
    S1.Range(S1.Cells(2, S1.Columns.Count).End(1), S1.Cells(2, S1.Columns.Count).End(1).End(xlDown)).Font.Bold = True
    S1.Range("A1").Select
    
    S1.Columns.AutoFit
    
    Set S1 = Nothing
    Set Pivot_Data = Nothing
    Set Pivot_Cache = Nothing
    Set Pivot_Table = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00") & " Saniye"
End Sub

Formüllü sayfaları makroya çevirmek

izcik

ornek1.xlsx dosyasını indir - download

ornek2.xlsm dosyasını indir - download

Korhan Ayhan

Administrator

Ekli dosyalar

izcik

izcik

izcik

Korhan Ayhan

Administrator

izcik

ornek.xlsx dosyasını indir - download

Korhan Ayhan

Administrator

izcik

izcik

Korhan Ayhan

Administrator

izcik

Korhan Ayhan

Administrator

izcik

izcik

Korhan Ayhan

Administrator

izcik

izcik

uzmanima_ornek2.xlsm dosyasını indir - download

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator