• DİKKAT

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

İstenilen Hücreye Atlama

M

manisali50

Banned
Katılım
29 Ekim 2010
Mesajlar
471
Excel Vers. ve Dili
Excel2003
Arkadaşlar merhaba..
Hücreye veriyi girdikten sonra enter tuşuna basıp belirlenen hücrelere atlamayı burada üstadlarımdan aldığım kodlarla hallettim ancak küçük bir sorun belirdi..Ekli dosyada anlattım.Yardımlarınızı bekliyorum.
Şimdiden teşekkürler
 

Ekli dosyalar

zamanında bir kod bulmuştum. sizi örneğe uyarlarsak...

xl2007'de problem yok. 0 girmek, veri silmek sorunsuz çalışıyor.
yalnız xl2003'te, nedendir bilmiyorum, çalışmadı.
bir uzmanımız yardımcı olur ise hallolur.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Select Case Target.Column
    Case Is = 1, 2: Target.Offset(, 1).Select
    Case Is = 3: Target.Offset(, 4).Select
    Case Is = 7: Target.Offset(, 2).Select
    Case Is = 9: Target.Offset(1, -8).Select
    Case Else
End Select

End Sub
 
Arkadaşım ilgine teşekkür ederim ama dediğiniz gibi önce çalışmıyordu. Ama biraz kodlarla oynayınca hallettim.. 0 (sıfır) ve boş hücrelerde dahi iş görüyor..Tek sorunum kaldı..Sıralama yaparken girdiğim ilk satırı sabit tutuyor..Kalan satırları ise sorunsuz sıralıyor..Üstadlarımdan bu sıralama sorunuma çare bekliyorum.
Aynı konuyu başka bir başlık altında da açmıştım..
Başkalarının da işine yanan düşüncesiyle kodları aşağıya yazıyorum..
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Select Case Target.Column
Case Is = 1, 2: Target.Offset(, 1).Select
Case Is = 3: Target.Offset(, 4).Select
Case Is = 7: Target.Offset(, 2).Select
Case Is = 9: Target.Offset(1, -8).Select
Case Else
End Select
If Intersect(Target, [I5:I5536]) Is Nothing Then Exit Sub
If Target <> "" Then
Range("A5:J5536").Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End If
End Sub

Bu kodlarla hem A-B-C-G-I sütunları arasında veri girişi yapıp,I hücresine veri girdikten sonra enter tuşuna bastığımızda tekrar A sütununa geri dönüş yapıyorsunuz,hem de girdiğiniz verileri A sütununu esas alarak sıralayabiliyorsunuz..(Sütunlar arsında tab ya da enter tuşu ile gezinebiliyorsunuz)Ama dediğim gibi çok basit bir sorun var,onda d üstadlarımın yardımını bekliyoruz.
 
Son düzenleme:
sn. manisal50.

aynı problem ile ilgili birden fazla konu açmanıza inanın gerek yok.

sort etmek istiyorsanız verdiğim tüm kodları silerek aşağıdaki kodu ekleyin.
sort işlemi ile ilgili bir problem çıkar ise makro kaydet seçeneği ile kendi makronuzu oluşturun ve kırmızı font bölümün yerine kopyalayın.

bir önerim de hücreleri birleştir seçeneğinde uzak durmanız. 3, 4, ve 5. satırları birleştirmişsiniz. bunun yerine satır genişliğini yükselterek tek bir satıra başlıklarınızı yazabilirsiniz. ben öyle yaptım ve sıralama makrom A3 hücresine göre. siz isterseniz aşağıdaki kodda yer alan A3'leri A5 yapın.



Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Dim ss As Long
ss = Cells(Rows.Count, 1).End(3).Row

Select Case Target.Column
    Case Is = 1: Target.Offset(, 1).Select
    Case Is = 2: Target.Offset(, 1).Select
    Case Is = 3: Target.Offset(, 4).Select
    Case Is = 7: Target.Offset(, 2).Select
    Case Is = 9:
[COLOR="Red"]        ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("A3"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sayfa1").Sort
            .SetRange Range("A3:J" & ss)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
[/COLOR]        Range("A" & ss).Offset(1, 0).Select
    Case Else
End Select

End Sub
 
Üstadım merhaba..
İşyerinde öğle arası 13,00-14,00 arası internet açıldığından ancak şimdi bakabildim çözümünüze..
I hücresine veri girdiğimde;
ActiveWorkbook.Worksheets("OCAK-Genel Liste").Sort.SortFields.Clear
hatası veriyor..(Sayfa1 yazdığınız yere orijinal sayfanın ismini yazdım..A3 leri de A5 yaptım)
 
kırmızılı yerleri silerek aşağıdaki kodu ekleyin. 2003'te hazırlandı. bir önceki mesajımda belirttiğim gibi sadece kayıt makrosu yaptım.

Kod: 
Range("A5:J" & ss).Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
 
Teşekkürüm tek kelime olacak : SÜPER..
Bu kadar kısa bir teşekkürü de size layık görmedim..
İlginize,bilginize,emeğinize sağlık..Çok çok teşekkür ederim..
 
rica ederim. ne yazıyorsak burada bulduklarımızdan. işinize yaradığına sevindim.
 
AA
CDF
KKL
ZZZ
654 66 666
775 8
99 000 000
125
217
357
888
999

şeklinde bir sıralama yapmak istiyorsanız bu konuda bilgim yok.

ancak yardımcı bir sütun vasıtası ile gerçekleştirilebilir. bu konudaki çözümümüm aşağıdaki gibi. farklı bir şey bilgim dahilinde değil.

iyi günler.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Dim ss As Long
ss = Cells(Rows.Count, 1).End(3).Row

Select Case Target.Column
    Case Is = 1: Target.Offset(, 1).Select
    Case Is = 2: Target.Offset(, 1).Select
    Case Is = 3: Target.Offset(, 4).Select
    Case Is = 7: Target.Offset(, 2).Select
    Case Is = 9:
        With Target.Offset(, 2)
            .FormulaR1C1 = "=IF(ISNUMBER(RC[-10]),3,IF(ISNUMBER(--LEFT(RC[-10],1)),2,1))"
            .Value = .Value
        End With
        Range("A2:K" & ss).Sort Key1:=Range("K2"), Order1:=xlAscending, Key2:=Range("A2") _
            , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
            xlSortNormal
        Range("A" & ss).Offset(1, 0).Select
    Case Else
End Select

End Sub
 
Arkadaşım ilgine teşekkür ediyorum.
Verdiğin kodları çalıştırdığımda;
Range("A2:K" & ss).Sort Key1:=Range("K2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
satırları sarıya boyanıp hata mesajı veriyor ve çalışmıyor..
Bu arada (K) sütununda da sürekli 3 rakamı beliriyor..
 
ben hücre birleştirme yapmadığım için kendi dosyamdaki şekli ile almışım.

aşağıdaki gibi deneyin

kod'daki A2, K2 ve A2'yi sırası ile A5, K5 ve A5 yapın. kırmızı font ile gösterilmiştir.
Kod: 
Range("A[COLOR="red"]5[/COLOR]:K" & ss).Sort Key1:=Range("K[COLOR="Red"]5[/COLOR]"), Order1:=xlAscending, Key2:=Range("A[COLOR="red"]5[/COLOR]") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal


WXSD, AAA, SDCF gibi metinsel ifadelerde 1,
6666 66 6666, 1239 45 217 gibi rakamlarla yazılan metinsel ifadelerde 2,
123, 455, 212 gibi rakamlarda 3 çıkması lazım.

buraya yüklediğiniz dosya üzerinden ben çalıştığımda bunlar oluyor çünkü. ilave bir şey eklediniz mi acaba.

ilk satır (5. satır) için aşağıdaki formül çalışıyor.
Kod: 
=IF(ISNUMBER(A5);3;IF(ISNUMBER(--LEFT(A5;1));2;1))
sonra formül
Kod: 
.Value = .Value
ile değere dönüşüyor
 
Son düzenleme:
Üstadım tekrar merhaba..
Kodlar çalışıyor..Ama ufak bir sorun yine var :
Harfleri gayet güzel bir şekilde sıralıyor.Ancak aynı başarıyı rakamlarda göstermiyor..Rakamları yine aynı mantıkla,yani değer büyüklüğüne göre sıralıyor..Oysa belirttiğimiz gibi ;

444 444 444
666 66
75
8
99

şeklinde sıralnamsanı istiyorum..
Bir sorun da şöyle eklendi :
Ben bu makroların ilk satırından sonra
ActiveSheet.Unprotect "a"
ve son satırından önce
ActiveSheet.Protect "a"

satırlarını ekledim..Bu şekilde sayfa koruması altında da makroların görev görmesini sağlıyordum..Ama bu satırları ekleyince makro çalışmıyor..
 
diğer konuda sorduğunuz farklı idi. ben de ona göre formül çıkarmıştım. çünkü "ASZX" vb harflerden oluşan bir metin, "6666 44 222 23472" vb ise -özel format ile böyle görünmesi sağlanmadığı takdirde- rakamlardan oluşan bir metin, 12345 ise -yine formatlanmadı ise- sayıdır.

şimdi bu soru ile konu değişiyor. harf ile başlayan verileri A'dan Z'ye, sayı olan verileri de metin imiş gibi 0'dan 9'a sıralamak istiyorsunuz.


kod'daki formülü aşağıdaki ile değiştirin.

Kod: 
.FormulaR1C1 = "=LEFT(IF(RC[-10]=0,""2 0"",IF(ISNUMBER(RC[-10]),""2 ""&TEXT(RC[-10],""#""),""1 ""&RC[-10])),1)"


protect - unprotect kısmına gelince.
normal bir makro çalıştırmıyorsunuz. worksheet_change event'ine göre excel sayfasında tanımlanan bir değişiklik gerçekleştirdiği takdirde tetiklenen komutlar dizisi çalıştırıyorsunuz.
her değişiklikte yazılan bütün komutlar çalışmakta. bunun için bu sayfada sayfa koruması yapmamak doğru olur. bir yöntemi varsa da ben bilmiyorum.
 
zannediyorum bu defa oldu.

eskisinin yedeğini alarak tüm kodları aşağıdaki ile değiştiriniz.

etkin bir sıralama olması için yardımcı K sütunundaki formüller değere dönüştürülmedi. hücrenin içindeki formüle rağmen boş gibi görünmesi için formatı ";;;" yapıldı. (hayır görünsün derseniz .NumberFormat = ";;;" satırını silebilirsiniz.)

iyi günler.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Dim ss As Long
ss = Cells(Rows.Count, 1).End(3).Row

Select Case Target.Column
    Case Is = 1: Target.Offset(, 1).Select
    Case Is = 2: Target.Offset(, 1).Select
    Case Is = 3: Target.Offset(, 4).Select
    Case Is = 7: Target.Offset(, 2).Select
    Case Is = 9:
        With Target.Offset(, 2)
            .FormulaR1C1 = "=IF(RC[-10]=0,1&"" ""&REPT(""Z"",7)&"" ""&RC[-10],IF(ISNUMBER(RC[-10]),LEFT(RC[-10])&"" ""&REPT(""Z"",7)&"" ""&RC[-10],1&"" ""&TEXT(RC[-10],""#"")))"
            .NumberFormat = ";;;"
        End With
        Range("A2:K" & ss).Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        Range("A" & ss).Offset(1, 0).Select
    Case Else
End Select

End Sub
 
Son düzenleme:
Muhteşem olmuş... Tekrar tekrar teşekkür ederim... İlginize,bilginize,emeğinize,herşeyden önce YÜREĞİNİZE sağlık..
 
rica ederim. iyi günler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst