otomatik sıralama

[bycakir]

merhaba aşağıdaki gibi bir üretim listem var. benim istediğim örneğin 4. sıraya aciliyet verildi ben 4 yazısını 1 e çevirdiğimde bu en uste gelsin ve tekrar numaraya göre sıralama yapsın istiyorum. yani yeni 1 en uste gelecek ve altına 2 3 4 5 6 diyte tekrar sıralayacak şimdiden teşekkurler.

1​	ZZ28210237
2​	ZZ28210237
3​	STOK
4​	ZZ28210237
5​	ZZ28210237
6​	STOK

 

[Trilenium]

İlgili hücreye gelip sağ tuşladığınızda aşağıdaki sıralama seçeneği işinizi görmüyor mu?

 

[MGokboruAtan]

ctrl + q ile çalıştırabilirsiniz

 

[bycakir]

İlgili hücreye gelip sağ tuşladığınızda aşağıdaki sıralama seçeneği işinizi görmüyor mu?

Ekli dosyayı görüntüle 249321

bu işimi görüyorda ben bunu otomatikleştirmek istiyorum.

 

[MGokboruAtan]

altın üye olmadığından indiremezsiniz sanırım gönderdiğim dosyayı kod olarak bunu girin makroyu kısayol yapın

Sub AciliyetSiralama()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    ' Çalışma sayfasını ayarla (Burada "Sheet1" olarak varsayılan adı kullanıyorum, gerektiğinde değiştirin)
    Set ws = ThisWorkbook.Sheets("Sayfa1")
    
    ' Sıralama yapılacak sütun numaraları
    Dim aciliyetSutunu As Integer
    Dim kodSutunu As Integer
    
    aciliyetSutunu = 1
    kodSutunu = 2
    
    ' Sayfadaki son satırı bul
    lastRow = ws.Cells(ws.Rows.Count, aciliyetSutunu).End(xlUp).Row
    
    ' Aciliyet ve Kod numarasına göre sıralama yap
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(2, aciliyetSutunu), ws.Cells(lastRow, aciliyetSutunu)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(2, kodSutunu), ws.Cells(lastRow, kodSutunu)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range(ws.Cells(1, aciliyetSutunu), ws.Cells(lastRow, kodSutunu))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Sıralama numarasını güncelle
    Dim currentNumara As Long
    currentNumara = 1
    
    For i = 2 To lastRow
        If ws.Cells(i, aciliyetSutunu).Value <> "STOK" And ws.Cells(i, aciliyetSutunu).Value <> "STOK2" Then
            ws.Cells(i, 1).Value = currentNumara
            currentNumara = currentNumara + 1
        End If
    Next i
End Sub

 

[bycakir]

altın üye olmadığından indiremezsiniz sanırım gönderdiğim dosyayı kod olarak bunu girin makroyu kısayol yapın

Sub AciliyetSiralama()
    Dim ws As Worksheet
    Dim lastRow As Long
   
    ' Çalışma sayfasını ayarla (Burada "Sheet1" olarak varsayılan adı kullanıyorum, gerektiğinde değiştirin)
    Set ws = ThisWorkbook.Sheets("Sayfa1")
   
    ' Sıralama yapılacak sütun numaraları
    Dim aciliyetSutunu As Integer
    Dim kodSutunu As Integer
   
    aciliyetSutunu = 1
    kodSutunu = 2
   
    ' Sayfadaki son satırı bul
    lastRow = ws.Cells(ws.Rows.Count, aciliyetSutunu).End(xlUp).Row
   
    ' Aciliyet ve Kod numarasına göre sıralama yap
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(2, aciliyetSutunu), ws.Cells(lastRow, aciliyetSutunu)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Cells(2, kodSutunu), ws.Cells(lastRow, kodSutunu)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range(ws.Cells(1, aciliyetSutunu), ws.Cells(lastRow, kodSutunu))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    ' Sıralama numarasını güncelle
    Dim currentNumara As Long
    currentNumara = 1
   
    For i = 2 To lastRow
        If ws.Cells(i, aciliyetSutunu).Value <> "STOK" And ws.Cells(i, aciliyetSutunu).Value <> "STOK2" Then
            ws.Cells(i, 1).Value = currentNumara
            currentNumara = currentNumara + 1
        End If
    Next i
End Sub

hocam elinize saglık ama ufak bir sorun var 1. satır hep sabit kalıyor geri kalan suralama tam olarak istediğim gibi sadece 1. sırayı değiştiremitorum
yeni verdigim 1 degeri hep 2 de kalıyor 1. sıraya çıkmıyor

 

[MGokboruAtan]

A1 ve B1 satırları başlık olarak örnek dosya oluşturdum A1 e sıra B1 e ise malzeme kodu ya da başka bir şey yazabilirsiniz

 

[bycakir]

hocam anladım teşekkurler fakat 3 . sıradaki numaraya 1 yazdıgımda bunu 1 e koymuyor 2 ye koyuyor. demek istedim bu

 

[bycakir]

mesela 6. sıradaki satıra 1 yazdım test olan

sıra	malzeme
1​	asdgsdg
2​	sdfgsdg
3​	STOK
4​	rfasf
1​	test
6​	ZZ28210237
7​	rfasf
8​	ZZ28210237
9​	STOK"1

sonuc asağıdaki gibi oluyor.

sıra	malzeme
1​	asdgsdg
2​	test
3​	sdfgsdg
4​	STOK
5​	rfasf
6​	ZZ28210237
7​	rfasf
8​	ZZ28210237
9​	STOK"1

 

[bycakir]

düzelttim 0 yazınca basageliyor

 

[MGokboruAtan]

gönderdiğim dosyayı indirebilseydiniz böyle bir problem olmadığını görebilirdiniz. Dosyamda 1 2 3 4 5 herhangi bir değer verdiğinde sorunsuz sıralayabiliyor

 

[bycakir]

gönderdiğim dosyayı indirebilseydiniz böyle bir problem olmadığını görebilirdiniz. Dosyamda 1 2 3 4 5 herhangi bir değer verdiğinde sorunsuz sıralayabiliyor

teşekkurler altın ıyelik aldım indirebilirim.

 

[MGokboruAtan]

hayırlı olsun