Soru VBA İLE SIRALAMA

Mukteda · 3 Ağustos 2022

Merhabalar,

Ekteki dosyada, RAPOR sayfasında, A kolonunu yeni ekleyip "Gurup Açıklaması" başlığını ekledim.

1- Mevcut VBA içerisinde, ÜRETİM-VERİ sayfasındaki gurup açıklamasını RAPOR sayfasına nasıl getirebilirim?

2- RAPOR Sayfasında, gurup açıklaması geldiktan sonra, ilk önce A kolonuna daha sonra C kolonuna göre sıralama nasıl yaptırabilirim?

VBA Kodları aşağıdadır:

Kod:

Private Sub Worksheet_Activate()
Dim sat As Worksheet, ur As Worksheet
sayfa = Array("SATIS-VERİ", "ÜRETİM-VERİ")
Set s = CreateObject("Scripting.Dictionary")
For Each syf In sayfa
    With Sheets(syf)
        For Each hcr In .Range(.Range("F2"), .Cells(Rows.Count, "F").End(3))
            If Not s.exists(hcr.Value) Then s.Add hcr.Value, hcr.Offset(0, 1).Value
        Next
    End With
Next
Me.Range("B2:B10000").ClearContents
Me.Range("B2").Resize(s.Count).Value = Application.Transpose(s.items())
Me.Range("C2").Resize(s.Count).Value = Application.Transpose(s.keys())
End Sub

Kitap2.xlsm dosyasını indir - download

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

www.dosya.tc

YUSUF44 · 3 Ağustos 2022

Doğru anladıysam aşağıdaki kodları dener misiniz?

PHP:

Private Sub Worksheet_Activate()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("ÜRETİM-VERİ")
Set s2 = Sheets("SATIS-VERİ")

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"""
Me.Range("A2:C10000").ClearContents

SORGU = "select distinct GURUP, [MALZEME AÇIKLAMASI], [MALZEME KODU] from [ÜRETİM-VERİ$] where [MALZEME KODU] is not null"
Set rs = con.Execute(SORGU)
[A2].CopyFromRecordset rs

son = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row, Cells(Rows.Count, "C").End(3).Row) + 1
SORGU = "select distinct GURUP, [MALZEME AÇIKLAMASI], [MALZEME KODU] from [SATIS-VERİ$] where [MALZEME KODU] is not null"
Set rs = con.Execute(SORGU)
Cells(son, "A").CopyFromRecordset rs

enson = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row, Cells(Rows.Count, "C").End(3).Row) + 1

ActiveSheet.Range("$A$1:$C$" & enson).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
End Sub

Mukteda · 3 Ağustos 2022

Merhaba Yusuf Bey,

İlginiz ve kıymetli yardımınız için çok teşekkür ederim.

Vermiş olduğunuz kod düzgün çalıştı, tamamdır. Ancak vaktim çok sınırlı olduğu için detaylı kontrol sağlayamıyorum.

Aslında bu sorun aşağıdaki konunun devamı idi...
Orada yanıt alamadığım için ve ilave farklı bir sorun olduğu için yeni konu açmak zorunda kaldım.

Aşağıdaki konudaki sorunun yanıtı sizin yazdığınız VBA karşılığı mıdır? (VBA Kodları tamamen değiştiği için bu şekilde sormak istedim.)

Soru - HER İKİ SAYFADA ORTAK OLAN MALZEMELER

Merhabalar, Elimde 900 küsür satır malzeme kodlarının olduğu bir veri sayfası var. Bunların üretim ve satış karşılığını aylara göre ÇOKEĞERSAY ile bulabiliyorum. Burada sorun yok. Ancak raporlama yaparken 900 küsür satır malzeme üzerinde olduğu için pek anlaşılır olmuyor. Filtre seçeneğini...

excel.web.tr

YUSUF44 · 3 Ağustos 2022

Benim çözümüm ordaki #4. mesajdaki çözümle benzer, yani önce iki sayfayı üöüncü sayfada topluyor sonra da 2. sayfada yinelenenleri kaldırıyor.

Muhtemelen istediğiniz çözüm olmuştur, siz kontrol edin, eksik ya da hata varsa ona göre bakalım.

Haluk · 3 Ağustos 2022

Yusuf Bey'in kodunda, 2 SQL sorgusu birleştirilerek tek sorgu kullanılabilir;

C#:

SORGU = " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [ÜRETİM-VERİ$] Where [MALZEME KODU] Is Not Null " & _
        " Union All " & _
        " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [SATIS-VERİ$] Where [MALZEME KODU] Is Not Null"

.

YUSUF44 · 3 Ağustos 2022

Haluk üstadım ben kodları birleştirmeyi bir türlü öğrenememiştim, bu desteğiniz için teşekkür ederim.

Ancak kodu denediğimde copyfromrecordset satırında Type missmatch hatası verdi.

Mukteda · 3 Ağustos 2022

YUSUF44' Alıntı:
Muhtemelen istediğiniz çözüm olmuştur, siz kontrol edin,

Merhaba Yusuf Bey,

Tekraren şükranlarımı sunarım. Çok sağ olun.

Bir önceki konuda ÖMER BEY yazmış olduğu kodda 248 satır geliyor, sizin kodlarınızda 249 satır geliyor. Fark ne olabilir?

Örnek-2: Ürün-8 Satış sayfasında var, ancak üretim sayfasında yoktur.
Sonuç: RAPOR sayfasına Ürün-8 açıklaması ile birlikte gelecektir. (Mevcut durumda farklı olan malzemeleri tablonun en altına "ayrıca" ekliyor. Farkları da tablonun "içine" yazmalı ve tabloyu bir bütün olarak sıralamalıdır.)

Örnek-3: Ürün-6 Üretim sayfasında var, ancak satış sayfasında yoktur.
Sonuç: RAPOR sayfasına Ürün-6 açıklaması ile birlikte gelecektir. (Mevcut durumda farklı olan malzemeleri tablonun en altına "ayrıca" ekliyor. Farkları da tablonun "içine" yazmalı ve tabloyu bir bütün olarak sıralamalıdır.)

Haluk' Alıntı:
Yusuf Bey'in kodunda, 2 SQL sorgusu birleştirilerek tek sorgu kullanılabilir;

Haluk Bey,

Değerli yardımınız için teşekkür ederim.

Kodları birleştiremedim, hata verdi. Bir bütün olarak paylaşabilir misiniz?

Haluk · 3 Ağustos 2022

YUSUF44' Alıntı:
Haluk üstadım ben kodları birleştirmeyi bir türlü öğrenememiştim, bu desteğiniz için teşekkür ederim.

Ancak kodu denediğimde copyfromrecordset satırında Type missmatch hatası verdi.

Geri dönen sonuçların içeriğini bilmiyorum ama bende bu şekilde çalıştı;

C#:

Private Sub Worksheet_Activate()
    Dim s1 As Worksheet, s2 As Worksheet, Con As Object, RS As Object, SORGU As String

    Set s1 = Sheets("ÜRETİM-VERİ")
    Set s2 = Sheets("SATIS-VERİ")

    Set Con = CreateObject("ADODB.Connection")
    Con.Open "Provider= Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & ";Extended Properties= 'Excel 12.0; HDR=YES'"

    Range("A2:C10000").ClearContents

    SORGU = " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [ÜRETİM-VERİ$] Where [MALZEME KODU] Is Not Null " & _
            " Union All " & _
            " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [SATIS-VERİ$] Where [MALZEME KODU] Is Not Null"

    Set RS = Con.Execute(SORGU)
    [A2].CopyFromRecordset RS
End Sub

.

Mukteda · 3 Ağustos 2022

Haluk' Alıntı:
Geri dönen sonuçların içeriğini bilmiyorum ama bende bu şekilde çalıştı;

Haluk Bey,
Tamamdır, ben de çalıştırdım, bu kısımda bir sorun yoktur. Teşekkür ederim.
Ancak 485 satır geldi.

Sorunun çözümü için Yusuf Bey veya siz 7 Numaralı mesajı inceleyebilirseniz sevinirim.

Esenlikle kalınız.

YUSUF44 · 3 Ağustos 2022

Ben hala çalıştıramadım, örnek dosyada sıkıntı var sanıyorum.

Alternatif olarak aşağıdaki gibi de kullanılabilir:

PHP:

Private Sub Worksheet_Activate()
    Dim Con As Object, RS As Object, SORGU As String

    Dim s1 As Worksheet, s2 As Worksheet, son As Integer
    Set s1 = Sheets("ÜRETİM-VERİ")
    Set s2 = Sheets("SATIS-VERİ")
    Range("A2:C10000").ClearContents
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "D").End(3).Row, s1.Cells(Rows.Count, "F").End(3).Row, s1.Cells(Rows.Count, "G").End(3).Row) + 1
    s1.Range("D2:D" & son).Copy [A2]
    s1.Range("F2:F" & son).Copy [C2]
    s1.Range("G2:G" & son).Copy [B2]
    son2 = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "D").End(3).Row, s2.Cells(Rows.Count, "F").End(3).Row, s2.Cells(Rows.Count, "G").End(3).Row) + 1
    s2.Range("D2:D" & son2).Copy Cells(son2 + 1, "A")
    s2.Range("F2:F" & son2).Copy Cells(son2 + 1, "C")
    s2.Range("G2:G" & son2).Copy Cells(son2 + 1, "B")
    
    enson = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row, Cells(Rows.Count, "C").End(3).Row) + 1
    
    ActiveSheet.Range("$A$1:$C$" & enson).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
End Sub

Farklı sonuç getirmeyle ilgili olarak dosyanızı görmeden yorum yapamam maalesef. Dosyanıza rapor sayfasından kopya oluşturun, birinde Haluk üstadın, diğerinde Ömer üstadın kodları olsun, öyle paylaşın ki karşılaştırabilelim. Hatta farklı bir sayfada o dosyada asıl olması gereken sonucu manuel olarak düzenlerseniz daha iyi olur.

Mukteda · 3 Ağustos 2022

YUSUF44' Alıntı:
Ömer üstadın kodları olsun,

Denemeler sırasında dosyayı bozmuşum Aşağıdaki linkten bakabilirsiniz.

Soru - HER İKİ SAYFADA ORTAK OLAN MALZEMELER

Merhabalar, Elimde 900 küsür satır malzeme kodlarının olduğu bir veri sayfası var. Bunların üretim ve satış karşılığını aylara göre ÇOKEĞERSAY ile bulabiliyorum. Burada sorun yok. Ancak raporlama yaparken 900 küsür satır malzeme üzerinde olduğu için pek anlaşılır olmuyor. Filtre seçeneğini...

excel.web.tr

YUSUF44' Alıntı:
asıl olması gereken sonucu manuel olarak düzenlerseniz daha iyi olur.

En başından ne yapmak istediğimi ekte izah etmeye çalıştım. Umarım anlaşılır olmuştur.

Kitap1__-_Kopya.xlsx dosyasını indir - download

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

s7.dosya.tc

YUSUF44 · 3 Ağustos 2022

Gönderdiğiniz dosyada herhangi bir makro yok. Ayrıca istediğim gibi farklı kodların uygulandığı ya da uygulanabileceği şekilde de dosyayı düzenlememişsiniz.

Yine de iki sayfadaki verileri birleştirdikten sonra sıralama yapan kodlar aşağıdaki gibidir:

PHP:

Private Sub Worksheet_Activate()
    Dim s1 As Worksheet, s2 As Worksheet, Con As Object, RS As Object, SORGU As String

    Set s1 = Sheets("ÜRETİM-VERİ")
    Set s2 = Sheets("SATIS-VERİ")

    Set Con = CreateObject("ADODB.Connection")
    Con.Open "Provider= Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & ";Extended Properties= 'Excel 12.0; HDR=YES'"

    Range("A5:C10000").ClearContents

    SORGU = " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [ÜRETİM-VERİ$] Where [MALZEME KODU] Is Not Null " & _
            " Union All " & _
            " Select Distinct [GURUP], [MALZEME AÇIKLAMASI], [MALZEME KODU] From [SATIS-VERİ$] Where [MALZEME KODU] Is Not Null"

    Set RS = Con.Execute(SORGU)
    [A5].CopyFromRecordset RS
    enson = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row, Cells(Rows.Count, "B").End(3).Row, Cells(Rows.Count, "C").End(3).Row)
    ActiveWorkbook.Worksheets("MALZEME-AY").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MALZEME-AY").Sort.SortFields.Add Key:=Range( _
        "A5:A" & enson), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("MALZEME-AY").Sort.SortFields.Add2 Key:=Range( _
        "C5:C" & enson), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MALZEME-AY").Sort
        .SetRange Range("A5:C" & enson)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Bu arada GURUP'tan kastınız Grup ise dosyanızda Grup olarak kullanmanızı tavsiye ederim. Eğer GURUP'un farklı bir anlamı varsa bu önerimi dikkate almayın lütfen.

Son olarak sıralama yaparken GURUP'a göre ıralandığında 1'den sonra 10'a geçer, 2'ye geçmesini istiyorsanız isimlendirmeyi GURUP-00 formatında yapmalısınız.Yani GURUP-01, GURUP-02 gibi.

Mukteda · 3 Ağustos 2022

YUSUF44' Alıntı:
Gönderdiğiniz dosyada herhangi bir makro yok. Ayrıca istediğim gibi farklı kodların uygulandığı ya da uygulanabileceği şekilde de dosyayı düzenlememişsiniz.

Merhabalar,

Harici link içeren dosyada istediğiniz gibi ve bizim olmasını istediğimiz gibi düzenlemiştik aslında...

Diğer önerilerinizi dikkate alacağım.

Geriye kalan kısımları fonksiyonlar ile çözmeye çalışacağım.

Bu hali ile tamamdır.

İlginiz ve değerli yardımlarınız için çok teşekkür ederim.

Sağlıcakla kalınız.

Soru VBA İLE SIRALAMA

Mukteda

Kitap2.xlsm dosyasını indir - download

YUSUF44

Destek Ekibi

Mukteda

Soru - HER İKİ SAYFADA ORTAK OLAN MALZEMELER

YUSUF44

Destek Ekibi

Haluk

Özel Üye

YUSUF44

Destek Ekibi

Mukteda

Haluk

Özel Üye

Mukteda

YUSUF44

Destek Ekibi

Mukteda

Soru - HER İKİ SAYFADA ORTAK OLAN MALZEMELER

Kitap1__-_Kopya.xlsx dosyasını indir - download

YUSUF44

Destek Ekibi

Mukteda