Soru Makro İle Sıraya Yazmak

[Hsn55]

İyi akşamlar
ekli dosya veri girişi sayfasında G18:V18 gücre aralığında ağaç boyları var. F20:F69 aralığında ise ağaçların çapları var. G20:V69 hücre aralığında ise çap ve boylara ait adet miktarları yazılı benim yapmak istediğim. Ağaç boylarının en küçüğü ve çaplarının en küçüğünden başlayarak makro ile verileri Sevk Pusalası sayfasına örnekte ki gibi buton yardımı ile aktarabilir miyiz. Yardımcı olursanız sevinirim. Saygılarımla

SIRALAMA.xlsx dosyasını indir - download

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

s6.dosya.tc

 

[ÖmerFaruk]

Sub Sıralamak()
    Dim Sh1 As Worksheet, Sh2 As Worksheet, Boy, Cap, Adet
    Dim i As Long, k As Long, Say As Long
    Set Sh1 = Worksheets("VERİ GİRİŞİ")
    Set Sh2 = Worksheets("SEVK PUSULASI")
    Boy = Sh1.Range("G18").Resize(1, Sh1.Range("G18").End(xlToRight).Column - 6).Value
    Cap = Sh1.Range("F20").Resize(Sh1.Range("F20").End(xlDown).Row - 19, 1).Value
    Adet = Sh1.Range("G20").Resize(UBound(Cap, 1), UBound(Boy, 2)).Value

    ReDim Liste(1 To UBound(Adet, 1) * UBound(Adet, 2), 1 To 3)
    For i = 1 To UBound(Adet, 1)
        For k = 1 To UBound(Adet, 2)
            If Adet(i, k) > 0 Then
                Say = Say + 1
                Liste(Say, 1) = Boy(1, k)
                Liste(Say, 2) = Cap(i, 1)
                Liste(Say, 3) = Adet(i, k)
            End If
        Next k
    Next i
    Sh2.Range("C8:E" & Rows.Count).ClearContents
    If Say > 0 Then
        Sh2.Range("C8").Resize(Say, 3) = Liste
        Sh2.Range("C8").Resize(Say, 3).Sort Key1:=Range("C8"), Order1:=xlAscending, Key2:=Range("D8")
    End If
    Set Sh1 = Nothing: Set Sh2 = Nothing: Erase Boy: Erase Cap: Erase Adet: Erase Liste: i = Empty: k = Empty: Say = Empty
End Sub

 

[Hsn55]

Hocam makro hata veriyor. Önce boyunu küçükten büyüğe doğru, sonra ise çapını küçükten büyüğe doğru sıralama yapacak

 

[ÖmerFaruk]

Benim hatam. Aşağıdaki satırı bularak BOLD olarak ilave ettiklerimi düzeltirseniz çalışacaktır.

Sh2.Range("C8").Resize(Say, 3).Sort Key1:=Sh2.Range("C8"), Order1:=xlAscending, Key2:=Sh2.Range("D8")

 

[Hsn55]

Sayın Ömer hocam çok teşekkür ederim. Ellerinize sağlık