• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sıralama hk.

Bu kod da farklı

Kod: 
Sub Makro1()

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
 .Calculation = xlManual
End With

ZBasla = TimeValue(Now)
zaman = Timer

sut1 = "a" 'başlangıç sutün
sut4 = "L" 'yardımcı sutün

sat1 = 7 'başlangıç satır
aranan = "2000000"

Set sh1 = Sheets(ActiveSheet.Name) 'sayfa adı
son = sh1.Cells(Rows.Count, sut1).End(3).Row 'son dolu satır

'veri2 = "hhhhhhhhhhhh"

For j = sat1 To son


If sh1.Cells(j, "c").Value = "KAYNAK GRUBU" Then
If Val(sh1.Cells(j, sut1).Value) <= 0 Then
sh1.Cells(j, sut1).Value = 123456789012#
End If
End If

If Val(sh1.Cells(j, sut1).Value) > 0 Then
veri1 = sh1.Cells(j, sut1)
veri2 = veri1
End If
sh1.Cells(j, sut4).Value = veri2

Next j

For j = son To sat1 Step -1
If Left(sh1.Cells(j, sut4).Value, Len(aranan)) <> aranan Then
Rows(j).Delete Shift:=xlUp
End If
Next j

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
  .Calculation = xlAutomatic
End With

End Sub
 
Merhaba,
Halit bey hayırlı akşamlar dilerim.
Silme kodu çalışıyor sadece L sütunuda 2000ler görünüyor. Halit bey sıralama makrosunu çalıştırdığım zaman verileri silmeye devam ediyor. 16 poz dan 6 adeti kalmış gersini silmiş. Halit bey sadece alttaki pozlar kalmış
ALS1.KG01
ALS1.KG02
ALS1.KG03
ALS1.KG04
ALS1.KG18
KL1.KG17
 
iyi akşamlar tam olarak ne yapmak istediğini anlamadım 21 nolu mesajdaki kodu denedinizmi?

Eğer olmamışsa örnek dosyanızda 40-50 satırlık bir veri hazırlayın ve başka bir sayfadada silindikten sonra olması gereken verileri yapın ve diğer bir sayfada sıralamanın yapılışını yapın ona göre bakalım.
 
Halit bey denedim. Sıralama makrosu çalıştırdığım zaman verileri siliyor. Halit bey ekteki Excel kitabında 1-2 sayfaları sıralamadan önceki hali ile sıraladıktan sonraki hali olarak gösterdim. kusura bakmayın sizi çok yoruyorum. hakkınızı lütfen helal edin.
 

Ekli dosyalar

sayfa (2) de 24 den 57 satırlar silinmiş ve sayfa (1) öyle aktarmışsınız krıter ney ki silindi bunlar
 
Halit bey sayfa 1 sıralama makrosunu çalıştıdıktan sonraki hali yani makroyu çalıştırdığım zaman verileri siliyor. Sayfa 2 ise sıralama makrosunu çalıştırmadan önceki hali
 
Gene anlamadım kusura bakmayın sayfa 1 ve sayfa 2 deki veriler hangi mesajdaki dosyadan geliyor.

Bunu anlamak için söylüyorum

örnek
1-Sayfa1 deki veriler esas almak üzere
2-Sayfa2 deki veriler silindikten sonra kalanlar
3-Sayfa3 de silindikten sonra kalanların sıralanmış şekli

gibi bir örnek dosya koyun sizin örnek dosyalarınız bir biri ile uyumlu değil
 
Tıpkı bu dosyadaki gibi sayfaları yapınız mevcut durum silinmiş hali ve sıralanmış son hali gibi

Burada yapılan a sutunda (2000000) ile başlayan veriler dışındaki satırlar silinmiştir ve kalanlar sıralanmıştır.
 

Ekli dosyalar

merhaba,
Halit bey sadece 1 Excel sayfası var başka yok. ben size aradaki farkı göstermek için sayfaları ayırmıştım. şimdiki Ekliyeceğim Excel sayfasında sıralama yapmadım. 7 satırdan başlıyor 62 kadar devam ediyor. Halit bey lütfen sıralama makrosu "CTRL-SHİFT+C çalıştırırmısınız şimdi daha iyi anlıyacaksınız.
 

Ekli dosyalar

Halit bey sizin vermiş olduğunuz makro aynı zamanda hep siliyor hep de sıralıyor mu ? Eğer öyle ise sizin daha önce yapmış olduğunuz makroyu kullanmama gerek yok değilmi
 
Makro1 sadece siliyor diğer kod sıralıyor ancak gönderdiğin dosyada 62 satır veri var ancak son dolu satır 19947 böyle olunca örnek dosyanız tutarsız oluyor. Bu durumda son dolu satır A sütunu yerine B sütunu yapmak gerekiyor.
 
Bu kod hem siliyor hemde sıralıyor.

Kod: 
Sub sirala()
ZBasla = TimeValue(Now)
zaman = Timer

sut1 = "a" 'başlangıç sutün
sut2 = "b" 'Taranacak sutün
sut3 = "K" 'yardımcı sutün
sut4 = "L" 'yardımcı sutün
sat1 = 7 'başlangıç satır

aranan = "2000000"
veri2 = "hhhhhhhhhhhh"



Set Sh1 = Sheets(ActiveSheet.Name) 'sayfa adı
son = Sh1.Cells(Rows.Count, sut2).End(3).Row 'son dolu satır

Sh1.Range(Sh1.Cells(sat1, sut3), Sh1.Cells(son, sut4)).Clear


Range(sut2 & sat1 & ":" & sut2 & son).Copy
Cells(7, sut3).PasteSpecial Paste:=2
Application.CutCopyMode = False

For j = sat1 To son

deg2 = Split(Sh1.Cells(j, sut2), "KG")
If UBound(deg2) > 0 Then
deg3 = deg2(0) & "KG" & Format(deg2(1), "000")
End If
Sh1.Cells(j, sut2) = deg3 '"h" & Format(deg3, "0000000000000")
Sh1.Cells(j, sut2).NumberFormat = "0"


If Sh1.Cells(j, "c").Value = "KAYNAK GRUBU" Then
If Val(Sh1.Cells(j, sut1).Value) <= 0 Then
Sh1.Cells(j, sut1).Value = 123456789012#
End If
End If

If Val(Sh1.Cells(j, sut1).Value) > 0 Then
veri1 = Sh1.Cells(j, sut1)
veri2 = veri1
End If
Sh1.Cells(j, sut4).Value = veri2
Sh1.Cells(j, sut4).NumberFormat = "0"
Next j

For j = son To sat1 Step -1
If Left(Sh1.Cells(j, sut4).Value, Len(aranan)) <> aranan Then
Rows(j).Delete Shift:=xlUp
End If
Next j


Range("A7:" & sut3 & son).Sort Key1:=Cells(7, sut2), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(sut3 & sat1 & ":" & sut3 & son).Copy
Cells(7, sut2).PasteSpecial Paste:=2
Application.CutCopyMode = False
    
Range("a1").Select


Sh1.Range(Sh1.Cells(sat1, sut3), Sh1.Cells(son, sut4)).Clear
zBitis = TimeValue(Now)
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
 
Halit hocam gerçekten harikasınız çok güzel oldu ve çok güzel çalışıyor. elinize emeğinize sağlık Allah sizden kat kat razı olsun. Halit hocam siz Ankara'da oturuyordunuz.
 
valentino06' Alıntı:
Halit hocam gerçekten harikasınız çok güzel oldu ve çok güzel çalışıyor. elinize emeğinize sağlık Allah sizden kat kat razı olsun. Halit hocam siz Ankara'da oturuyordunuz.
Genişletmek için tıkla ...

Evet Ankara'da oturuyorum.
 
Halit bey sizinle tanışmak isterim. Ankaranın neresinde oturuyorsunuz.
 
Anladım. Forumda bu şekilde yazışmak olmuyor. Halit bey e mail veya facebook falan varmı tabi siz isterseniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst