- Katılım
- 8 Mart 2009
- Mesajlar
- 504
- Excel Vers. ve Dili
- 2010
ekteki excel sayfasındaki verileri sıralatma ve saydırma;
Ekli dosyalar
-
32.5 KB Görüntüleme: 38
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Sirala()
Dim i As Long
Dim rng As Range
Application.ScreenUpdating = False
i = Cells(Rows.Count, "E").End(3).Row
Set rng = Range("E7:E" & i)
Range("F7") = "=COUNTIF(" & rng.Address & ",E7)"
Range("F7").AutoFill Destination:=Range("F7:F" & i)
Range("E7:F" & i).Sort Key1:=[F1], key2:=[E1]
Application.ScreenUpdating = True
MsgBox "Sıralama Tamamdır...", vbInformation, "N. YEŞERTENER"
End Sub
Merhaba,Necdet bey çok olandan az olana sıra yapsa ve yandaki satıra aşağıya doğru satır satır, çoktan aza doğru olanların birer birer yazarak karşılarına kaçar adet olduğunu yazdırabilirmiyiz.
Sub Sirala()
Dim i As Long
Dim rng As Range
Application.ScreenUpdating = False
i = Cells(Rows.Count, "E").End(3).Row
Set rng = Range("E7:E" & i)
Range("F7") = "=COUNTIF(" & rng.Address & ",E7)"
Range("F7").AutoFill Destination:=Range("F7:F" & i)
Range("E7:F" & i).Sort Key1:=[F1], key2:=[E1]
Application.ScreenUpdating = True
MsgBox "Sıralama Tamamdır...", vbInformation, "N. YEŞERTENER"
End Sub
Sub Tek_Sirala()
Dim d
Dim i As Long
Dim x As Variant
Dim dizi
Set d = CreateObject("Scripting.Dictionary")
For i = 7 To Cells(Rows.Count, "E").End(3).Row
x = Cells(i, "E")
If Not d.exists(x) Then
d.Add x, 1
Else
d.Item(x) = d.Item(x) + 1
End If
Next i
dizi = d.Keys
Range("G7").Resize(UBound(dizi) + 1, 1) = Application.WorksheetFunction.Transpose(dizi)
dizi = d.items
Range("H7").Resize(UBound(dizi) + 1, 1) = Application.WorksheetFunction.Transpose(dizi)
i = Cells(Rows.Count, "G").End(3).Row
Range("G7:H" & i).Sort Key1:=[H7], order1:=xlDescending
End Sub
Tam olarak anlamadım.Necdet bey ayrıca cümlenin ilk 15 veya 20 karakterine göre yapsa ve ben bu 15-20 sayısını sayfada sizin tanımladığınız boş bir hücreye (A1) yazarak değiştirebilsem, bu şekilde bir sıralama mümkünmü acaba.
Sn. necdet bey, verileri teke düşürüp yaptığı sıralama da sanki son satırda kayıtlı olan dataya ait verileri dikkata almıyor. Örneğinizde ŞAMPUAN 5 olmalı, ama sıralamada hiç yok.
Merhaba,Ellerinize sağlık teşekkürler.
cümlenin ilk 15 veya 20 karakterine göre sıralama yapsa ve ben bu karekter sayısını sayfada sizin tanımladığınız boş bir hücreye (A1) yazarak değiştirebilsem, (yani cümlenin ilk 10 karakterine göre bazende 15 karakterine göre, sayıyı ben değiştirebileyim) bu şekilde bir sıralama mümkünmü acaba. (foruma eklediğim deneme sayfasındaki sıralanacak veriler tek kelime halinde sizin vermiş olduğunuz makroyu ben cümlelerde kullanıyorum onun için ilk karakterlerini diyorum) A1 hücresine 15 yazacağım ve verileri bana sıralayacak ancak ilk 15 karakterine göre,
teke indirilmiş şekilde.
Teşekkürler.
Sub Tek_Sirala()
Dim d
Dim i As Long
Dim x As Variant
Dim dizi
Dim Veri
Set d = CreateObject("Scripting.Dictionary")
For i = 7 To Cells(Rows.Count, "E").End(3).Row
x = Left(Cells(i, "E"), Range("A1"))
If Not d.exists(x) Then
Veri = Array(x, 1)
d.Add x, Veri
Else
Veri = d.Item(x)
Veri(1) = Veri(1) + 1
d.Item(x) = Veri
End If
Next i
dizi = d.items
i = Cells(Rows.Count, "G").End(3).Row
If i < 7 Then i = 7
Range("G7:H" & i).ClearContents
For i = 0 To d.Count - 1
Veri = dizi(i)
Cells(i + 7, "G") = Veri(0)
Cells(i + 7, "H") = Veri(1)
Next i
i = Cells(Rows.Count, "G").End(3).Row
Range("G7:H" & i).Sort Key1:=[H7], order1:=xlDescending
End Sub
Merhaba,Necdet bey kusura bakmassanız, verilerin (veri) sayfasında olduğunu ve (sayfa2) ye sıralamasını istesek mümkünmü acaba, veri sayfasında veiler (E) stununda 7 satırdan başlayıp aşağıya doğru iniyor. Teşekkürler.
ayrıca kendimizi geliştirmek adına bu makro yazmayı nasıl öğrenebilirim nereden başlamam gerekli,
insan utanıyor inanın yazılı makroyu bile sadece sayfasını değiştirmesini dahi bilmiyorum. Saygılarımla.
Sub Tek_Sirala()
Dim d
Dim i As Long
Dim x As Variant
Dim shV As Worksheet
Dim sh2 As Worksheet
Dim dizi
Dim Veri
Set shV = Sheets("Veri")
Set sh2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
For i = 7 To shV.Cells(Rows.Count, "E").End(3).Row
x = Left(shV.Cells(i, "E"), Range("A1"))
If Not d.exists(x) Then
Veri = Array(x, 1)
d.Add x, Veri
Else
Veri = d.Item(x)
Veri(1) = Veri(1) + 1
d.Item(x) = Veri
End If
Next i
dizi = d.items
i = sh2.Cells(Rows.Count, "A").End(3).Row
If i < 7 Then i = 7
sh2.Range("A2:B" & i).ClearContents
For i = 0 To d.Count - 1
Veri = dizi(i)
sh2.Cells(i + 2, "A") = Veri(0)
sh2.Cells(i + 2, "B") = Veri(1)
Next i
i = sh2.Cells(Rows.Count, "A").End(3).Row
sh2.Range("A2:B" & i).Sort Key1:=sh2.[B1], order1:=xlDescending
Application.ScreenUpdating = True
MsgBox "SIRALAMA BİTMİŞTİR...", vbInformation, "N. YEŞERTENER"
sh2.Select
End Sub
Merhaba,Necdet Bey G sütunun sonuna yani bittiği yere TOPLAM olan miktarı H sütunun sonuna yazması için devamı için nasıl bir makro yazılır.
Sub Tek_Sirala()
Dim d
Dim i As Long
Dim x As Variant
Dim shV As Worksheet
Dim sh2 As Worksheet
Dim dizi
Dim Veri
Set shV = Sheets("Veri")
Set sh2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
For i = 7 To shV.Cells(Rows.Count, "E").End(3).Row
x = Left(shV.Cells(i, "E"), Range("A1"))
If Not d.exists(x) Then
Veri = Array(x, 1)
d.Add x, Veri
Else
Veri = d.Item(x)
Veri(1) = Veri(1) + 1
d.Item(x) = Veri
End If
Next i
dizi = d.items
i = sh2.Cells(Rows.Count, "A").End(3).Row
If i < 7 Then i = 7
sh2.Range("A2:B" & i).ClearContents
For i = 0 To d.Count - 1
Veri = dizi(i)
sh2.Cells(i + 2, "A") = Veri(0)
sh2.Cells(i + 2, "B") = Veri(1)
Next i
i = sh2.Cells(Rows.Count, "A").End(3).Row
sh2.Range("A2:B" & i).Sort Key1:=sh2.[B1], order1:=xlDescending
'----------- TOPLAM SATIRI EKLENİR ----------
sh2.Cells(i + 1, "A") = "TOPLAM"
sh2.Cells(i + 1, "B") = "=SUM(B2:B" & i & ")"
'---------- TOPLAM SATIR EKLEME SONU --------
Application.ScreenUpdating = True
MsgBox "SIRALAMA BİTMİŞTİR...", vbInformation, "N. YEŞERTENER"
sh2.Select
End Sub
Word sayfasından veri almak mümkünmü ekteki word sayfasındaki başlıkları excel sayfasına makro yardımı ile nasıl alabiliriz.
Forumda Kitap satışı konusunda arama yapınız.VBA ile ilgili olarak öncelikli olarak hangi kitaptan başlamamız gerekir kitap adı verirmisiniz.