- Katılım
- 24 Mayıs 2014
- Mesajlar
- 20
- Excel Vers. ve Dili
- 2007
Merhaba, ben A sütunundaki "ayakkabı" "telefon" "tşört" harici ve boş hücre harici ne varsa harf sırasına göre sıralama makrosu yada formülü nasıl olabilir
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=EĞER(YADA(B2="ayakkabı";B2="telefon";B2="tşört");"sıralama";"sırala")
=EĞERHATA(İNDİS($B$2:$B$7;KÜÇÜK(EĞER(EBOŞSA($B$2:$B$7)+
($A$2:$A$7<>"sırala");"";SATIR($B$2:$B$7)-MİN(SATIR($B$2:$B$7))+1);
SATIR(B1)));EĞERHATA(İNDİS($D$2:$D$7;KÜÇÜK(EĞER(EBOŞSA($D$2:$D$7)+
($C$2:$C$7<>"sırala");"";SATIR($D$2:$D$7)-MİN(SATIR($D$2:$D$7))+1);
SATIR(B1)-TOPLA.ÇARPIM(--DEĞİL((EBOŞSA($B$2:$B$7)+($A$2:$A$7<>"sırala"))))));""))
Sub Ozet_Rapor()
Dim Veri As Range, Alan As Range
Dim Satir As Long, Son As Long
Dim Liste() As Variant, Say As Integer
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).ClearContents
Satir = 2
Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Liste = Array("ateş", "heykel", "bulut")
Set Alan = Range("R2:S" & Son)
For Each Veri In Alan
Say = 0
If Veri.Value <> "" Then
On Error Resume Next
Say = WorksheetFunction.Match(Veri.Value, Liste, 0)
On Error GoTo 0
If Say > 0 Then GoTo 10
If WorksheetFunction.CountIf(Range("A:A"), Veri.Value) = 0 Then
Cells(Satir, 1) = Veri.Value
Cells(Satir, 2) = WorksheetFunction.CountIf(Alan, Veri.Value)
Satir = Satir + 1
End If
End If
10 Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub