- Katılım
- 1 Şubat 2020
- Mesajlar
- 6
- Excel Vers. ve Dili
- Excel 2013
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
1. tablo orijinal şekli |
2.tabloda protokol numarasına göre otomatik sıralama yapıyor |
yeni veri girince eğer protokol 7000 den küçükse ( 2. tabloda ) 7000 ile 41 arasına alıyor |
yeni veri girince eğer protokol 7000 den büyükse ( 2. tabloda ) en sona alıyor. |
makro ile sıralama yapınca sırası bozulmasın istiyorum |
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:B10000]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Value
son = Cells(Rows.Count, "B").End(3).Row
Target.Offset(0, -1) = WorksheetFunction.Max(Range("A1:A" & son)) + 1
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveSheet.Sort
.SetRange Range("A1:F" & son)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sat = WorksheetFunction.Match(a, Range("B1:B" & son), 0)
Cells(sat, "C").Select
End Sub