isime göre koşullu sıralama

[airfresh]

ekteki örneği incelermisiniz... yardımlarınızı bekliyorum...

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
If RefEdit1.Value = Empty Then
    MsgBox "Taşınacak alanı önce seçmeleisiniz!!", vbCritical, "UYARI"
    Exit Sub
End If
If MsgBox("Seçili alanı en alta taşımak istiyormusunuz?", vbYesNo, "TAŞIMA") = vbNo Then Exit Sub
sat = Cells(65536, "B").End(xlUp).Row + 1
Range(RefEdit1.Value).Cut Range("B" & sat)
Application.CutCopyMode = False
Range("B2:D" & sat).Sort Range("B2")
Unload Me
End Sub

 

[Necdet]

Merhaba,

Sayın Evren yanıtlamış, bende pek anladığımı söyleyemem ama B sütununda yapılacak bir değişkiliği son satıra aktarma işlemini yaptım.

Eksik gedik olabilir. Deneyiniz. Kodlar ilgili sayfanın kod bölümünde.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range(Cells(Target.Row, "B"), Cells(Target.Row, "D")).Cut
Range("B" & [B65536].End(3).Row + 1).Insert Shift:=xlDown
Application.EnableEvents = True
Son:
End Sub

 

[airfresh]

ilginiz için tşk.. Evren abinin yaptığı program ne yapıyor tam anlamadım.. Necdet abinin ki güzel fakat isteğime tam manası ile cevap veriyor sayılmaz. Belki de ben tam anlatamadım. Necdet abinin yaptığı kendisinin de belirttiği gibi B stununda yapılan değişikliği en alt satıra atıp sıralama yapıyor. Ben istiyorum ki B stununda alfabetik sıralama yapsın sadece YENİ MÜŞTERİ yazanları en alta atsın ve B stununda değişiklik yapılan satırdaki CARİ KOD ile CARİ HESAP DÖKÜMÜ dahil olmak üzere arasındaki tüm satırı taşısın. Ya aslında ben butona falan ihtiyaç duymuyordum ama nasip olursa pazartesi askere gidiyorum ve yerime bakacak kişi baya bi zorlanacak. onun için yardımımza gerçekten ihtiyacım var... Saygılarımla...

 

[Necdet]

Merhaba

Değişik bir mantık denedim. Dosyayı inceler misiniz. Eksik olan yerleri de açıklarsınız sevinirim. Yardımcı olabilirsem olurum, olmazsa ustalardan destek alırız.

B sütununda yapılan değişikliğe göre çalışan bir makro. Ama C ve D sütununda ne olacak bilmediğim için sadece sıralamaya kattım, c ve d sütununu olduğu gibi bıraktım.

Yine kodlar ilgili sayfanın kod bölümünde olmalı.

En Büyük Asker, Bizim Asker,

Güle güle gidiniz askere, güle güle geliniz.

Şimdiden iyi tezkereler diliyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Columns("B:B").Replace What:="YENİ MÜŞTERİ", Replacement:="ZZZZZ"
SonSatir = [B65536].End(3).Row
Range("B2:D" & SonSatir).Sort Key1:=Range("B2")
Columns("B:B").Replace What:="ZZZZZ", Replacement:="YENİ MÜŞTERİ"
Application.EnableEvents = True
Son:
End Sub

 

[Orion1]

ilginiz için tşk.. Evren abinin yaptığı program ne yapıyor tam anlamadım.. .

Butona basıyorsunuz.Userform çıkıyor.
Refedit nesenesine tıklıyorsunuz.Sonra sayfa üzerinde akatarılmasını istediğiniz satırı seçiyorsunuz.Ve tamam tuşuna basınıyorsunuz .Önce seçili satır ene alta atıyor.Sonrada sıralıyor.

 

[airfresh]

Necdet abi çok güzel olmuş ellerine sağlık.... evren abime de çok tşkler... vakit ayırıp ilgilendiniz...

En Büyük Asker, Bizim Asker,

Güle güle gidiniz askere, güle güle geliniz.

Şimdiden iyi tezkereler diliyorum.

Çok saol abi ) sizleri koruyup geleyim ben hayırlısı ile... )

 

[Necdet]

Vatan sana emanet airfresh kardeşim

 

[airfresh]

Necdet abimin dikkatine....
abi gerekli açıklamayı örnek içinde yaptım... iilgilenebilirmisin... sana da zahmet verdik...

 

[Necdet]

Merhaba,

Butona bağladığınız kodları aşağıdaki şekilde değiştirdim.
Sayfadaki kodları da kaldırdım.

Sub Macro1()
SonSat = [B65536].End(3).Row
Range("B2:B" & SonSat).Copy
[E2].Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Columns("E:E").Replace What:="YENİ MÜŞTERİ", Replacement:="ZZZZZ"
Range("B2:E" & SonSat).Sort Key1:=Range("E2")
Columns("E").ClearContents
End Sub