• DİKKAT

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

ilk 30 karakterde kelime aratma;

A

abbasonline

Katılım
8 Mart 2009
Mesajlar
504
Excel Vers. ve Dili
2010
Yapmak istediğim ekteki dosyada mevcut, Cümlelerin ilk 30 karakterinde yazılan kelimeden kaç tane olduğunu saydırmak istiyorum
 

Ekli dosyalar

konuyu tam anlayamama ragmen ilk etapta sanirim cumlelerin icerisinde C sutunlarini saymak istiyorsunuz ilk otuz karakterine gore..

D7 icin:
=(LEN(LEFT(E7;30))-LEN(SUBSTITUTE(LEFT(E7;30);C7;"")))/LEN(C7)

yaniliyorsam duzeltiniz lutfen..
 
merhaba;
sorunuzu tam olarak anlayamamakla birlikte;

Kod: 
Sub Tablo_Doldur()
Dim alan1 As Range
Dim alan2 As Range
Dim alan3 As Range
Dim tar1, tar2 As Date

Set alan1 = Worksheets(1).Range("c7:c39000")
Set alan2 = Worksheets(1).Range("e7:e39000")
Set alan3 = Worksheets(2).Range("c6:k11")

 tar1 = Sheets("Sayfa2").Range("a1") 
 tar2 = Sheets("Sayfa2").Range("a2") 
Dim VV As Integer
V = Array("", "ARMUT", "BAHÇE", "DUVAR", "KAPI", "SİLGİ", "BARDAK")
h = Array("", "HAVA", "KİRAZ", "YAZICI", "EVE", "DUMANLI", "SAĞLIĞA", "GÜZEL", "İNSAN", "ALİ")
For i = 1 To alan1.Cells.Count
    
10:
        If alan1.Cells(i).Value = "" Then Exit For
        V1Adres = 0
        H1Adres = 0
        
        If alan1.Cells(i).Offset(0, -2).Value >= tar1 And alan1.Cells(i).Offset(0, -2).Value <= tar2 Then
        
        Başlık1 = alan1.Cells(i).Value
        
        For j = 1 To 6
            V1 = V(j)
            
            If V1 = Başlık1 Then
                V1Adres = j
            
                For t = 1 To 9
30:
                        If t > 9 Then Exit For
                        H1 = h(t)
                        VV = InStr(1, (Left(alan2.Cells(i).Value, 30)), H1, vbTextCompare)
                            If VV < 31 And VV > 0 Then
                            H1Adres = t
                            alan3.Cells(V1Adres, H1Adres).Value = alan3.Cells(V1Adres, H1Adres).Value + 1
                            Else
                            t = t + 1
                            GoTo 30
                            End If
                

                 Next t
    
            End If
        If V1Adres <> 0 Or H1Adres <> 0 Then
        Exit For
        End If
        Next j
        
        
        
    Else
20:
        i = i + 1
        GoTo 10
    End If
Next
End Sub
 
Selamlar,

Alternatif olarak aşağıdaki formülüde denermisiniz.

C6 hücresine uygulayınız.
Kod: 
=TOPLA.ÇARPIM((Sayfa1!$A$7:$A$1000>=$A$1)*(Sayfa1!$A$7:$A$1000<=$A$2)*(Sayfa1!$C$7:$C$1000=$B6)*ESAYIYSA(MBUL(C$5;SOLDAN(Sayfa1!$E$7:$E$1000;30);1)))
 
Arkadaşlar hepinize yardımlarınızdan dolayı teşekkür ederim çalıştı çok sağolun
 
excel03 YAZMIŞ OLDUĞUNUZ MAKRODA HAVA, KİRAZ YAZICI YAZAN YERLERE HÜCRELERİN İSİMLERİNİ YAZSAK UYGUN OLURMU NASIL BİR DÜZENLEME YAPMAMIZ GEREKİR. (Örn Kiraz yerine D5 hava yerine C5 gibi çünkü ben bu kelimeleri değiştirebileyim hücrede hangi kelime yazıyorsa onu arasın.
 
merhaba;
Kod: 
Sub Tablo_Doldur()
Dim alan1 As Range
Dim alan2 As Range
Dim alan3 As Range
Dim tar1, tar2 As Date
Dim veri(9)
Dim VV As Integer

Set alan1 = Worksheets(1).Range("c7:c39000")
Set alan2 = Worksheets(1).Range("e7:e39000")
Set alan3 = Worksheets(2).Range("c6:k11")
tar1 = Sheets("Sayfa2").Range("a1")
tar2 = Sheets("Sayfa2").Range("a2")
For w = 1 To 9
veri(w) = alan3.Cells(w).Offset(-1, 0).Value
Next w
V = Array("", "ARMUT", "BAHÇE", "DUVAR", "KAPI", "SİLGİ", "BARDAK")
h = Array("", veri(1), veri(2), veri(3), veri(4), veri(5), veri(6), veri(7), veri(8), veri(9))
For i = 1 To alan1.Cells.Count
    
10:
        If alan1.Cells(i).Value = "" Then Exit For
        V1Adres = 0
        H1Adres = 0
        
        If alan1.Cells(i).Offset(0, -2).Value >= tar1 And alan1.Cells(i).Offset(0, -2).Value <= tar2 Then
        
        Başlık1 = alan1.Cells(i).Value
        
        For j = 1 To 6
            V1 = V(j)
            
            If V1 = Başlık1 Then
                V1Adres = j
            
                For t = 1 To 9
30:
                        If t > 9 Then Exit For
                        H1 = h(t)
                        VV = InStr(1, (Left(alan2.Cells(i).Value, 30)), H1, vbTextCompare)
                            If VV < 31 And VV > 0 Then
                            H1Adres = t
                            alan3.Cells(V1Adres, H1Adres).Value = alan3.Cells(V1Adres, H1Adres).Value + 1
                            Else
                            t = t + 1
                            GoTo 30
                            End If
                

                 Next t
    
            End If
        If V1Adres <> 0 Or H1Adres <> 0 Then
        Exit For
        End If
        Next j
        
        
        
    Else
20:
        i = i + 1
        GoTo 10
    End If
Next
End Sub
 
excel03, yardımlarınız için teşekkürler, ancak makroyu her çalıştırdığımda tablonun içindeki rakamlar katlanarak büyüyüp gidiyor, (Örn: 1 ise makroyu çalıştırdığımda 2 oluyor birdaha çalıştırdığımda 3 oluyor, 2 ise 4 oluyor birdaha çalıştırdığımda 6 oluyor böyle sürekli artarak devam ediyor.)
 
ayrıca makro otomatik çalışsa biz veri girdikçe kendisini güncellese uygun olurmu.
 
merhaba;
abbasonline' Alıntı:
excel03, yardımlarınız için teşekkürler, ancak makroyu her çalıştırdığımda tablonun içindeki rakamlar katlanarak büyüyüp gidiyor, (Örn: 1 ise makroyu çalıştırdığımda 2 oluyor birdaha çalıştırdığımda 3 oluyor, 2 ise 4 oluyor birdaha çalıştırdığımda 6 oluyor böyle sürekli artarak devam ediyor.)
Genişletmek için tıkla ...

Kod: 
..............
Set alan2 = Worksheets(1).Range("e7:e39000")
Set alan3 = Worksheets(2).Range("c6:k11")
alan3.ClearContents                   '< Bu satırı ekleyiniz.
tar1 = Sheets("Sayfa2").Range("a1")
tar2 = Sheets("Sayfa2").Range("a2")
..............
 
EXCEL03, sizin vermiş olduğunuz makroda değişiklikler yaparak kendi çalışma sayfama uyarlamaya çalıştım ancak,verilerin bulunduğu sayfanın ismi (TÜM VUKUATLAR) tablonun bulunduğu sayfanın ismi (TABLO) ayrıca tabloda bulunan, B sütunudaki isismler 18 tane yaptım ve aynı şekilde makroya işledim ancak beceremedim dosyada özel olduğu için foruma koyamıyorum.
 
Excel03, sorunu çözdüm teşekkürler, kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst