Makro ile hücre ve hücre değeri saytırmak otomatik sıralama yapmak.

[ahzola]

Selamlar değerli üstadlar;

Makro ile otomatik sıralama yaptırtmak istiyorum.

Kriterimiz:
Dolu hücreler sayılacak.
eşitlik durumunda;
hücre değeri toplanacak ve hücre değeri toplamı
AZ OLAN üste gelecek.

2. bir kriterimiz ise dolu hücre sayısını belirttiğim sütuna
yazacak.

not : Formül sadece rakamların olduğu alanda çalışacak.

yardımlarınızı bekliyorum
iyi günler.

 

[denemetor]

Bir ornek dosya olusturdum. Once bir satirda kac hucrenin dolu oldugunu sayiyor. Ardindan en cok dolu satirdaki hucre en yukarida olacak sekilde siraliyor. Esitlik durumunda toplami en az olan satiri daha yukariya getiriyor. Istediginiz bu yanlis anlamamisim degil mi?

 

[ahzola]

Evet aynen doğru.
Ama değerleri değiştirdiğimde tepki vermiyor.

 

[denemetor]

Degerleri degistirdikten sonra "test" isimli makroyu calistirmaniz gerekiyor.

 

[ahzola]

Nereden çalıştıracağım peki?
özür dilerim ben yeni başladım bu işlere

 

[ahzola]

Butun gibi vs bişey ise bende gözükmüyor maalesef

 

[denemetor]

Ozur dilemenize hic gerek yok. Calistir diye bir buton koydum sayfanin uzerine. Umarim isinizi gorur.

 

[ahzola]

Emeğiniz için teşekkür ederim.

Herhangi bir hücre değerini sildiğiğim yada değeri değiştirtiğim zaman

Run time error 438 diyor.

 

[denemetor]

Sanirim versiyon farki neden oluyor. Bir de ekteki halini dener misiniz?

 

[ahzola]

Maalesef aynı hata numarası ile yine uyarı veriyor.

 

[denemetor]

Dosya bende sorunsuz sekilde calistigindan hataya neyin sebep oldugunu anlayamadim. Kusura bakmayin, daha fazla yardimci olamiyorum. Bilen biri mutlaka yardimci olacaktir.

 

[ahzola]

Emeğinizi için teşekkür ederim.

Aşağıdaki gibi hata çıkıyor arkadaşlar.
Formülü düzeltebilecek yada. Yada
yeniden formül yazacak arkadaşlara
teşekkür ederim simdiden.

[/IMG]

 

[snx111]

sayfanın adını değiştirmişsiniz sanırım sheet1 görünüyorsa sayfa1 olarak değiştirin oda olmazsa;
makrodaki kodunuz ;

sayfa1.sort.sortfields.clear

 

[ahzola]

aşağıdaki makro 9 nolu msg dan indirdiğim dosyaya ait.
yukarıdaki hatayı veriyor yine bu kodara bakarak söylermisiniz;
nereyi ne şekilde düzelteceğim.


Private Sub CommandButton1_Click()
Range("D6").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(RC[2]:RC[70],""<>""&"""")"
Range("D6").Select
Selection.AutoFill Destination:=Range("D684")
Range("D684").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[3]:RC[71])"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C84")
Range("C6:C84").Select
Cells.Select
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("D691") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("C6:C91") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").Sort
.SetRange Range("A6:BV91")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.EntireColumn.AutoFit
End Sub

 

[snx111]

ActiveWorkbook.Worksheets("Sayfa1"). olanları silin
sayfa1. diye değiştirin

 

[ahzola]

ActiveWorkbook.Worksheets("Sayfa1"). olanları silin
sayfa1. diye değiştirin

ActiveWorkbook.Worksheets("Sayfa1").Sort.SortField s.Clear

yukarıdaki değil
aşağıdakimi olacak tam olarak. activeworkbook atılacakmı ?

Sayfa1.Sort.SortField s.Clear

 

[snx111]

Private Sub CommandButton1_Click()
Range("D6").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(RC[2]:RC[70],""<>""&"""")"
Range("D6").Select
Selection.AutoFill Destination:=Range("D6:d84")
Range("D684").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[3]:RC[71])"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C84")
Range("C6:C84").Select
Cells.Select
Sayfa1.Sort.SortFields.Clear
Sayfa1.Sort.SortFields.Add Key:=Range("D691") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Sayfa1.Sort.SortFields.Add Key:=Range("C6:C91") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sayfa1.Sort
.SetRange Range("A6:BV91")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
Range("a1").Select
End Sub

 

[ahzola]

Sizin kodu modüle yapıştırdım. verilerde değişiklik yaptım
ok dedim. yine aynı hata kodunu verdi debug dediğimde ise aşağıdaki
görüntü geldi

[/IMG]

 

[Mustafa MUTLU]

Bunu denermisin

Sub test()
Application.ScreenUpdating = False
[D6] = "=COUNTA(F6:BV6)"
Range("D6").Select
Selection.AutoFill Destination:=Range("D684")
Range("D684").Select
Selection.Copy
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("D6:BV84").Select
Selection.Sort Key1:=Range("D6"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

[C6] = "=SUM(F6:BV6)"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C84")
Range("C6:C84").Select
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


[B6] = "=D6-(C6/8400)"
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B84")
Range("B6:B84").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B6:BV84").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Sheets("Sayfa1").Range("B2:B84").ClearContents
Application.ScreenUpdating = True

Range("B5").Select
End Sub

 

[ahzola]

Mustafa bey
teşekkür ederim alakanız için. Denemeden
yazıyorum. Sizde 2003 kullanıyorsunuz.
Şayet çalıştı ise. Kitap halinde yayınlayabilirmiziniz.
zahmet olmaz ise
Allah sizden razı olsun. 3 4 gündür
bununla uğraşıyorum.
İnşallah halledeceğiz