yeniden diz

[Barons]

merhaba

ekli dosyada A kolonundaki sıralama rakamını değiştirerek değiştirdiğimde tüm sıranın otomatik olarak yeniden dizilmesi mümkünmüdür? (makro buton yardımı ile)

Teşekkürler

 

[Ömer]

Merhaba,

Bu şekilde deneyin..

Sub Sırala()
    Range("A2:M" & [A65536].End(3).Row).Sort Range("A2")
End Sub

.

 

[Barons]

Sn.Ömer Hocam,
Teşekkürler ancak herhangi bir sıradaki (A sütununda) değeri örnek:4 değerini 1 yapınca ,2 tane 1 değeri oluyor.Bu değişiklikten sonra kalan değerleride tekrar artan şeklinde sıralamak mümkünmüdür?

Teşekkürler

 

[Barons]

çözümü yokmu üstadlar...lütfen yardım

 

[Ömer]

Sayın Barons,

Sorunuzu anlayamadım. Benim anladığım bu istediğinizi yukarıda verdiğim kod yapıyor. Yeni veri girdikten sonra butona basmanız gerekir.

Farklı bir şey soruyorsanız yeni bir dosya ekleyerek detaylı açıklayınız..

.

 

[Barons]

hocam,
şöyle izah edeyim..
A sütununda 1,2,3....şeklinde sıralı giden sayılar var.Bu sayılar mevcut işlerin aciliyet sıraları aynı zamanda.
örnek; 3 sayısını 1 yaptık diyelim yani 3 nolu iş ilk sıraya gelecek ancak üstte zaten 1 nolu iş vardı...sizin kod ile 2 tane 1 no'lu iş oluyor.işte burada sıkıntı var.üstteki 2 olacak ve diğerleride tekrar sırayla dizilecek.
Hocam sizin kod sadece sıralıyor ,ikinci kez dizme işlemi yapmıyor.
umarım anlatabilmişimdir.

 

[meslan]

Merhaba
Dosynız ekte

 

[leumruk]

Merhaba,
Syn meslan yanıtlamış; ama ben de bir kod hazırlamıştım, boşa gitmesin. Alternatif olarak düşünebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("a2:a" & [a65536].End(3).Row)) Is Nothing Then Exit Sub
Dim st As Variant
Set st = Range("a" & Target.Row & ":m" & Target.Row)
Application.EnableEvents = False
Rows(Val(Target) + 1).Insert shift:=xlDown
st.Cut Cells(Target + 1, "a")
Range("a2:m" & [a65536].End(3).Row).SpecialCells(xlCellTypeBlanks).Delete
[a2].AutoFill Destination:=Range("a2:a" & [a65536].End(3).Row), Type:=xlFillSeries
Application.CutCopyMode = False
Application.EnableEvents = True
MsgBox "Yeni sıralama yapıldı.", vbInformation, "leumruk"
End Sub

 

[Barons]

Süper..istediğim tam olarak buydu...Üstadlara çok teşekkürler

 

[Barons]

Tekrar merhaba
sayfanın change olayına değilde bir butona bağlayarak kullanmak istiyorum.Bu şekilde değişiklik mümkünmü acaba?

Teşekkürler

 

[Barons]

Sn.Meslan,
çok teşekkürler ancak bir sorun var...örnek:1 rakamını 10 yapınca sorun çıkyor ve 2'den başlıyor.
Leumruk hocam sizinkindede öyle.ilk numarayı en sona atamıyorum.

Teşekkürler

 

[meslan]

Sn.Meslan,
çok teşekkürler ancak bir sorun var...örnek:1 rakamını 10 yapınca sorun çıkyor ve 2'den başlıyor.
Leumruk hocam sizinkindede öyle.ilk numarayı en sona atamıyorum.

Teşekkürler

Merhaba
Şunu bir dene

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Rows, [A2:A65536]) Is Nothing Then Exit Sub
Application.EnableEvents = False
a = 2
If Target.Row = 2 Then a = [A65536].End(3).Row + 1
Rows(Target.Row).Cut
Rows(a).Insert Shift:=xlDown
Range("A2:M" & [A65536].End(3).Row).Sort Range("A2")
For i = 2 To [A65536].End(3).Row
   Cells(i, 1).Value = i - 1
Next
Application.EnableEvents = True
End Sub

 

[meslan]

Alternatif olarak şu kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Rows, [A2:A65536]) Is Nothing Then Exit Sub
Application.EnableEvents = False
a = 2
If Target.Row = 2 Then a = [A65536].End(3).Row: GoTo 1
Set b = [A:A].Find(Target.Value, LookAt:=xlWhole)
If Not b Is Nothing And b.Row <> Target.Row Then
a = b.Row
Else
 Set b = [A:A].FindNext(b)
If Not b Is Nothing Then a = b.Row
End If
1 Rows(Target.Row).Cut
Rows(a + 1).Insert Shift:=xlDown
Range("A2:M" & [A65536].End(3).Row).Sort Range("A2")
For i = 2 To [A65536].End(3).Row
   Cells(i, 1).Value = i - 1
Next
Application.EnableEvents = True
End Sub

 

[Barons]

Hocam her 2 kodda tam istediğim gibi çalışıyor...çok teşekkürler...Allah ne muradınız varsa versin...

 

[meslan]

Aminnnn.. Sizinde

 

[Barons]

Hocam delirecem ya...sizin gönderdiğiniz dosyada çalışıyor hatta sizin gönderdiğiniz dosyada sayfa adını değiştirdim yine sorun yok ama benim orjinal dosyada hata veriyor.yine
a=2 hatası..
herşey aynı defalarca denedim ama olmuyor...hata resmi aşağıda hocam

 

[meslan]

Kodun en başına "dim a as Integer" ifadesini ekleyin