özel sıralama listeme buton atayamıyorum!

[Cem DURU]

Merhabalar işim gereği tüm gün excel deyim desem yeridir. Turizm, yolcu taşımacılığı yapıyorum. kendi sistemimizden excel olarak aldığım yolcu listelerindeki araçların gideceği otelleri önce birleştirip sonra, özel sıralama ile kolayca sıraya diziyorum buraya kadar bir sorunum yok. ancak her seferinde sıralama > özel sıralama > sıralama ölçütü > düzen den kendi özel listemi seçmek biraz vaktimi alıyor. Her seferinde aynı bloklar ile çalıştığım için, bir düğme atayıp hızlıca bu işimi halletmek istiyorum. internetten çok izledim ancak bu işlem için yapamadım.Hata veriyor, sıralamıyor. yardımcı olabilecek varmıdır?

ÖRNEK LİSTEM:
https://ibb.co/TwNhgCh

 

[relaxim]

Merhaba örnek dosyanızı eklerseniz yardımcı olan çıkacaktır.

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[Cem DURU]

sıralama yapmak için eklediğim düğmeden de aldığım hata kodu ise :
https://ibb.co/nw30yHK budur

 

[necati]

sıralama yapmak için eklediğim düğmeden de aldığım hata kodu ise :
https://ibb.co/nw30yHK budur

Merhaba,
Kırmızı renkli satırda bölünme olmuş. O satırı yukarıdaki satırın sonuna alın.
, DataOption:=xlSortNormal

 

[Cem DURU]

Merhaba,
Kırmızı renkli satırda bölünme olmuş. O satırı yukarıdaki satırın sonuna alın.
, DataOption:=xlSortNormal

Dedıgınız gibi yaptım ama her seferınde aynı satırda yapıyor bu işleri. ben seçip tuşa basınca seçtiğim kısmı sıralamasını istiyordum.

 

[necati]

Resim değilde örnek dosya yüklerseniz daha kolay sonuç alabiliriz.

 

[relaxim]

Merhaba

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[Cem DURU]

https://s6.dosya.tc/server19/428vh9/ORNEK.XLS.html

ÖRNEK DOSYAM BUDUR. UCAK SAATLERINE GÖRE AYIRDIGIM BÖLÜMLERİ, OTEL SIRALAMASINA GÖRE DÜĞME İLE DİZMEK İSTİYORUM. OTEL SIRA LİSTEM FILAN HAZIR DİZEBİLİYORUM AMA BEN BU İŞLEMİ TEK DÜĞME İLE YAPMAK İSTİYORUM.

 

[Cem DURU]

Merhaba

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

MERHABA

 

[Korhan Ayhan]

Merhaba,

Sanıyorum Capslock tuşunuz açık kaldı..

Bir kuralı hatırlatmakta fayda var..

Büyük Harf Kısıtlaması:
- Mesaj yazarken büyük harf kullanmak bağırmak anlamına geleceği için yazılarınızı kesinlikle büyük harf kullanarak yazmayınız.

 

[necati]

Dosyayı ekte bulabilirsiniz.
Açıklama dosya içinde.

 

[veyselemre]

Kriterler sayfası oluşturup A1:A ya sıralamanızı yerleştirip kodu çalıştırın.

Sub test()
    Dim strOrder, area, rng
    With Sheets("Kriterler")
        strOrder = Join(Application.Transpose(.Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row)), ",")
    End With

    With Worksheets("Transfer Takip Formu")
        With .Range("F3:F" & .Cells(Rows.Count, "F").End(3).Row).SpecialCells(xlCellTypeConstants)
            For Each area In .Areas
                Set rng = area.Offset(, -5).Resize(, 7)
                With rng.Parent.Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=area, SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, DataOption:=xlSortNormal, _
                                    CustomOrder:=CVar(strOrder)
                    .SetRange rng
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            Next area
        End With
    End With

End Sub

 

[Cem DURU]

Merhaba,

Sanıyorum Capslock tuşunuz açık kaldı..

Bir kuralı hatırlatmakta fayda var..

kusura bakmayın işimden dolayı hep Caps Lock açıp çalışıyorumda.

 

[Cem DURU]

Kriterler sayfası oluşturup A1:A ya sıralamanızı yerleştirip kodu çalıştırın.

Sub test()
    Dim strOrder, area, rng
    With Sheets("Kriterler")
        strOrder = Join(Application.Transpose(.Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row)), ",")
    End With

    With Worksheets("Transfer Takip Formu")
        With .Range("F3:F" & .Cells(Rows.Count, "F").End(3).Row).SpecialCells(xlCellTypeConstants)
            For Each area In .Areas
                Set rng = area.Offset(, -5).Resize(, 7)
                With rng.Parent.Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=area, SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, DataOption:=xlSortNormal, _
                                    CustomOrder:=CVar(strOrder)
                    .SetRange rng
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            Next area
        End With
    End With

End Sub

vallahi bu işte baya bi yeniyimde beceremedim.sıralama listem bu şekilde çıkıyor bunu nereye kopyalıyacağım tam olarak.


"ADB DEPAR,KUSADASI GOLF RESORT,FAUSTINA HOTEL,AKBULUT,GREEN GOLD GÜZELCAMLI,GRAND BELISH HOTEL,FLORA GARDEN EPHESUS,DAVUTLAR PALM WINGS BEACH RESORT,FLORA SUITES HOTEL KUSADASI,ATLANTIQUE HOLIDAY CLUB,MY AEGEAN STAR HOTEL KUSADASI,SENTINUS BEACH HOTEL,BATIHAN OTEL,EPHESIA HOTEL,EPHESIA HOLIDAY BEACH,UNIQUE LIFE STYLE,GRAND SAHINS HOTEL,SIGNATURE BLUE RESORT,FANTASIA" & _
" DE LUXE HOTEL KUSADASI,PALMIN HOTEL,OPUS APARTMENTS KUSADASI,MARBEL HOTEL BY PALM WINGS,LIBERTY KUSADASI,OTIUM SEALIGHT RESORT,GRAND BLUE SKY HOTEL,LE BLEU HOTEL & RESORT,INFINITY BY YELKEN (EX IMBAT),MARTI BEACH HOTEL,TUNTAS FAMILY SUITES KUSADASI,PONZ BOUTIQUE HOTEL KUSADASI,ASENA HOTEL,ROSY SUITES,ALTINSARAY HOTEL,SURTEL HOTEL,ILAYDA AVANTGARDE,DERICI HOTEL,ILAY" & _
"DA HOTEL,HOTEL BY KARAASLAN INN,PALM HOTEL KUSADASI,PALOMA MARINA SUITES,CASA DEL SOLE HOTEL,THE CITYS HILL HOTEL,CHARISMA DE LUXE,KORUMAR HOTEL DE LUXE,LADONIA HOTELS ADAKULE,RAMADA SUITES KUSADASI,RAMADA RESORT BY WYNDHAM KUSADASI AND GOLF,KUSTUR CLUB HOLIDAY VILLAGE,TUSAN BEACH RESORT,PINE BAY HOLIDAY RESORT,LABRANDA EPHESUS PRINCESS KUSADASI,AQUA FANTASY HOTEL,P" & _
"ALM WINGS EPHESUS BEACH RESORT,RICHMOND EPHESUS RESORT,KORUMAR EPHESUS BEACH & SPA RESORT HOTEL,ARIA CLAROS BEACH & SPA RESORT,SUNIS EFES ROYAL PALACE RESORT & SPA,NOTION KESRE BEACH HOTEL & SPA OZDERE,KARYA FAMILY RESORT,CLUB BEYY RESORT HOTEL,KARYA FAMILY RESORT,CLUB MARVY,GRAND EFE HOTEL,PALOMA PASHA,DOGAN PARADISE,DOGAN BEACH RESORT & SPA OZDERE,CACTUS PARADISE " & _
"BEACH,GUMULDUR RESORT HOTEL GRAND SAHINS,CACTUS CLUB YALI HOTELS & RESORT GUMULDUR,MAYA BISTRO HOTEL BEACH,CLUB RESORT ATLANTIS SEFERIHISAR,LEBEDOS PRINCESS SEFERIHISAR,ANGORA BEACH RESORT" & _
""

 

[Cem DURU]

Dosyayı ekte bulabilirsiniz.
Açıklama dosya içinde.

üstad gerçekten uğraşmışsın eline sağlık tam da istediğim tarzda ama listemi buna nasıl dahil edicem. nasıl aktif etmem gerek. birde otellerle birlikte yanındaki kişi sayılarınında sıralanması gerekli.

 

[veyselemre]

Sub test()
    Dim strOrder, area, rng

    strOrder = "ADB DEPAR,KUSADASI GOLF RESORT,FAUSTINA HOTEL,AKBULUT,GREEN GOLD GÜZELCAMLI,GRAND BELISH HOTEL,FLORA GARDEN EPHESUS,DAVUTLAR PALM WINGS BEACH RESORT,FLORA SUITES HOTEL KUSADASI,ATLANTIQUE HOLIDAY CLUB,MY AEGEAN STAR HOTEL KUSADASI,SENTINUS BEACH HOTEL,BATIHAN OTEL,EPHESIA HOTEL,EPHESIA HOLIDAY BEACH,UNIQUE LIFE STYLE,GRAND SAHINS HOTEL,SIGNATURE BLUE RESORT,FANTASIA" & _
               " DE LUXE HOTEL KUSADASI,PALMIN HOTEL,OPUS APARTMENTS KUSADASI,MARBEL HOTEL BY PALM WINGS,LIBERTY KUSADASI,OTIUM SEALIGHT RESORT,GRAND BLUE SKY HOTEL,LE BLEU HOTEL & RESORT,INFINITY BY YELKEN (EX IMBAT),MARTI BEACH HOTEL,TUNTAS FAMILY SUITES KUSADASI,PONZ BOUTIQUE HOTEL KUSADASI,ASENA HOTEL,ROSY SUITES,ALTINSARAY HOTEL,SURTEL HOTEL,ILAYDA AVANTGARDE,DERICI HOTEL,ILAY" & _
               "DA HOTEL,HOTEL BY KARAASLAN INN,PALM HOTEL KUSADASI,PALOMA MARINA SUITES,CASA DEL SOLE HOTEL,THE CITYS HILL HOTEL,CHARISMA DE LUXE,KORUMAR HOTEL DE LUXE,LADONIA HOTELS ADAKULE,RAMADA SUITES KUSADASI,RAMADA RESORT BY WYNDHAM KUSADASI AND GOLF,KUSTUR CLUB HOLIDAY VILLAGE,TUSAN BEACH RESORT,PINE BAY HOLIDAY RESORT,LABRANDA EPHESUS PRINCESS KUSADASI,AQUA FANTASY HOTEL,P" & _
               "ALM WINGS EPHESUS BEACH RESORT,RICHMOND EPHESUS RESORT,KORUMAR EPHESUS BEACH & SPA RESORT HOTEL,ARIA CLAROS BEACH & SPA RESORT,SUNIS EFES ROYAL PALACE RESORT & SPA,NOTION KESRE BEACH HOTEL & SPA OZDERE,KARYA FAMILY RESORT,CLUB BEYY RESORT HOTEL,KARYA FAMILY RESORT,CLUB MARVY,GRAND EFE HOTEL,PALOMA PASHA,DOGAN PARADISE,DOGAN BEACH RESORT & SPA OZDERE,CACTUS PARADISE " & _
               "BEACH,GUMULDUR RESORT HOTEL GRAND SAHINS,CACTUS CLUB YALI HOTELS & RESORT GUMULDUR,MAYA BISTRO HOTEL BEACH,CLUB RESORT ATLANTIS SEFERIHISAR,LEBEDOS PRINCESS SEFERIHISAR,ANGORA BEACH RESORT" & _
               ""

    With Worksheets("Transfer Takip Formu")
        With .Range("F3:F" & .Cells(Rows.Count, "F").End(3).Row).SpecialCells(xlCellTypeConstants)
            For Each area In .Areas
                Set rng = area.Offset(, -5).Resize(, 7)
                With rng.Parent.Sort
                    .SortFields.Clear
                    .SortFields.Add2 Key:=area, SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, DataOption:=xlSortNormal, _
                                    CustomOrder:=CVar(strOrder)
                    .SortFields.Add2 Key:=area.Offset(, 1), _
                                     SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                    .SetRange rng
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            Next area
        End With
    End With

End Sub