• DİKKAT

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

Benzer içerikli (aynı değil) hücreleri gruplama

  • Konbuyu başlatan Konbuyu başlatan ofergun
  • Başlangıç tarihi Başlangıç tarihi
O

ofergun

Katılım
28 Temmuz 2011
Mesajlar
7
Excel Vers. ve Dili
Türkçe
Merhabalar,

Elimde 200.000'i aşkın satırı olan bir tablo var. Bir sütundaki hücrelerde 15-20 kelimelik cümleler var. Ben burada anahtar kelimeler belirleyerek (anahtar kelime belirlemeden olsa çok daha iyi olur) bu satırları gruplamak istiyorum. Örneğin hücre içerikleri aşağıdaki gibi olsun.

Pazardan üç elma ve dört armut aldım.
Pazardan üç elma ve dör armut aldım.
Pazarda üç elma ve dört armut aldım
Pazardan üç elmave dört armut aldım.

Yukarıdaki hücreleri içeren satırlar gruplandırmak istiyorum. Konunun çözülmesi birçok kişinin iş yükünü azaltacağından dolayı çok önemlidir. Tam istediğim olmasa bile alternatif yollar varsa onları da yazarsanız sevinirim.
 
Örnek dosyanızı dosya.tc yada dosyaupload.com a yüklerseniz daha hızlı dönüş alabilir siniz.

Bazı durumlarda burada verilen 3 satır cümle yeterli olmayabiliyor. Daha farklı sorunlar çıkabiliyor.
 
Bu bir denemedir. Deneyiniz.

Mantık kurulduktan sonra kriterler arttırılarak doğru sonuçlar elde edilebilir.


Kod: 
Dim orgliste(100000, 2) As String
Dim verisayisi, grupno, i, j As Long
Dim esit As Boolean
Dim cumleyeni, cumleorg As String
Dim toleransharfsayisi, toleranskelimesayisi As Integer

Sub menu()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 toleransharfsayisi = 5
 toleranskelimesayisi = 1
    Call veriyukle
    Call karsilastir
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Function kelime_esitligi()
  cumleyeniliste = Split(cumleyeni, " ")
  cumleorgliste = Split(cumleorg, " ")
  say = 0
  For i3 = 1 To UBound(cumleyeniliste)
   If UBound(cumleorgliste) >= UBound(cumleyeniliste) Then
     If cumleyeniliste(i3) = cumleorgliste(i3) Then say = say + 1
   End If
  Next i3
  If say + toleranskelimesayisi = UBound(cumleyeniliste) Then
     orgliste(i, 2) = orgliste(j, 2)
     Cells(i, 2) = orgliste(j, 2)
     esit = True
     kelime_esitligi = True
     Exit Function
  End If
  kelime_esitligi = False
End Function

Function bosluksuz_esitmi()
  If Replace(cumleyeni, " ", "") = Replace(cumleorg, " ", "") Then
     orgliste(i, 2) = orgliste(j, 2)
     Cells(i, 2) = orgliste(j, 2)
     esit = True
     bosluksuz_esitmi = True
     Exit Function
  End If
  bosluksuz_esitmi = False
End Function

Sub karsilastir()
   For i = 1 To verisayisi
      cumleyeni = orgliste(i, 1)
      If orgliste(i, 2) <> "0" Then GoTo son2
      esit = False
      For j = 1 To verisayisi
        cumleorg = orgliste(j, 1)
        If orgliste(j, 2) = "0" Then GoTo son1
        If bosluksuz_esitmi Then Exit For
        If kelime_esitligi Then Exit For
        
son1:
      Next j
      
      If esit = False Then
         grupno = grupno + 1
         orgliste(i, 2) = grupno
         Cells(i, 2) = grupno
      End If
      
son2:
   Next i
End Sub

Sub veriyukle()
 sonsatir = Cells(Rows.Count, "A").End(3).Row
 For i = 1 To sonsatir
    orgliste(i, 1) = Cells(i, 1).Value
    If i = 1 Then
       orgliste(i, 2) = "1"
       Cells(i, 2) = 1
       grupno = 1
    Else
       orgliste(i, 2) = "0"
    End If
 Next i
 verisayisi = i - 1
End Sub
 
Son düzenleme:
Üstat çok teşekkür ederim. Fakat VBA bilmediğim için bunu yapamam sanırım.:oops: :(

asri' Alıntı:
Bu bir denemedir. Deneyiniz.

Mantık kurulduktan sonra kriterler arttırılarak doğru sonuçlar elde edilebilir.


Kod: 
Dim orgliste(100000, 2) As String
Dim verisayisi, grupno, i, j As Long
Dim esit As Boolean
Dim cumleyeni, cumleorg As String
Dim toleransharfsayisi, toleranskelimesayisi As Integer

Sub menu()
 toleransharfsayisi = 5
 toleranskelimesayisi = 1
    Call veriyukle
    Call karsilastir
End Sub

Function kelime_esitligi()
  cumleyeniliste = Split(cumleyeni, " ")
  cumleorgliste = Split(cumleorg, " ")
  say = 0
  For i3 = 1 To UBound(cumleyeniliste)
   If UBound(cumleorgliste) >= UBound(cumleyeniliste) Then
     If cumleyeniliste(i3) = cumleorgliste(i3) Then say = say + 1
   End If
  Next i3
  If say + toleranskelimesayisi = UBound(cumleyeniliste) Then
     orgliste(i, 2) = orgliste(j, 2)
     Cells(i, 2) = orgliste(j, 2)
     esit = True
     kelime_esitligi = True
     Exit Function
  End If
  kelime_esitligi = False
End Function

Function bosluksuz_esitmi()
  If Replace(cumleyeni, " ", "") = Replace(cumleorg, " ", "") Then
     orgliste(i, 2) = orgliste(j, 2)
     Cells(i, 2) = orgliste(j, 2)
     esit = True
     bosluksuz_esitmi = True
     Exit Function
  End If
  bosluksuz_esitmi = False
End Function

Sub karsilastir()
   For i = 1 To verisayisi
      cumleyeni = orgliste(i, 1)
      If orgliste(i, 2) <> "0" Then GoTo son2
      esit = False
      For j = 1 To verisayisi
        cumleorg = orgliste(j, 1)
        If orgliste(j, 2) = "0" Then GoTo son1
        If bosluksuz_esitmi Then Exit For
        If kelime_esitligi Then Exit For
        
son1:
      Next j
      
      If esit = False Then
         grupno = grupno + 1
         orgliste(i, 2) = grupno
         Cells(i, 2) = grupno
      End If
      
son2:
   Next i
End Sub

Sub veriyukle()
 sonsatir = Cells(Rows.Count, "A").End(3).Row
 For i = 1 To sonsatir
    orgliste(i, 1) = Cells(i, 1).Value
    If i = 1 Then
       orgliste(i, 2) = "1"
       Cells(i, 2) = 1
       grupno = 1
    Else
       orgliste(i, 2) = "0"
    End If
 Next i
 verisayisi = i - 1
End Sub
Genişletmek için tıkla ...
 
ofergun' Alıntı:
Üstat çok teşekkür ederim. Fakat VBA bilmediğim için bunu yapamam sanırım.:oops: :(
Genişletmek için tıkla ...

Yapamamak diye bir şey yok, yapmak isteyip istememek diye bir şey vardır
:)

Aşağıdaki video da excel dosyasına nasıl makro eklenir anlatımı mevcut.
Kodları sayfanızda bu şekilde yapıştırın. Bir butona bağlayın. Butona bağlama da anlatılmış durumda.

Verileriniz A1 sütunundan başlamalı , Program gruplamaları B1 den itibaren yapacaktır.

Bu kodlar şu an için sadece iki kriter ile gruplama yapar.
1- tüm boşlukları siler ve karşılaştırır.
2- kelime kelime karşılaştırma

https://www.youtube.com/watch?v=gEB5VXqDxUw
 
Çok teşekkür ederim. :)

asri' Alıntı:
Yapamamak diye bir şey yok, yapmak isteyip istememek diye bir şey vardır
:)

Aşağıdaki video da excel dosyasına nasıl makro eklenir anlatımı mevcut.
Kodları sayfanızda bu şekilde yapıştırın. Bir butona bağlayın. Butona bağlama da anlatılmış durumda.

Verileriniz A1 sütunundan başlamalı , Program gruplamaları B1 den itibaren yapacaktır.

Bu kodlar şu an için sadece iki kriter ile gruplama yapar.
1- tüm boşlukları siler ve karşılaştırır.
2- kelime kelime karşılaştırma

https://www.youtube.com/watch?v=gEB5VXqDxUw
Genişletmek için tıkla ...
 
ofergun' Alıntı:
Çok teşekkür ederim. :)
Genişletmek için tıkla ...

Kod 100000 satır için çalışır. Bunu arttırmak için 100000 rakamını değiştiriniz. 1000000 dan fazla vermeyin :)
ayrıca satır sayısı arttıkça sonuçlanması da uzun sürecektir.

Kodda biraz da hızlanması için günceleme yapıldı.

toeranskelimesayisi=1 dir. İKi farklı cümleden bir kelime aynı olmaz ise aynı cümle olarak gruplar.
Buradaki değeri 2 yaparsanız 2 farklı kelimede olsa aynı cümle olarak değerlendirir.
 
Denedim fakat yapamadım. Bir hata veriyor. İçerisindeki isimleri veya başka bir bilgiyi değiştirmem gerekiyor mu Ör "orgliste". Aşağıda işaretlediğim noktayı hatalı gösteriyor.

Sub veriyukle()
sonsatir = Cells(Rows.Count, "A").End(3).Row
For i = 1 To sonsatir
orgliste(i, 1) = Cells(i, 1).Value
If i = 1 Then
orgliste(i, 2) = "1"
Cells(i, 2) = 1
grupno = 1
Else
orgliste(i, 2) = "0"
End If
Next i
verisayisi = i - 1
End Sub

asri' Alıntı:
Kod 100000 satır için çalışır. Bunu arttırmak için 100000 rakamını değiştiriniz. 1000000 dan fazla vermeyin :)
ayrıca satır sayısı arttıkça sonuçlanması da uzun sürecektir.

Kodda biraz da hızlanması için günceleme yapıldı.

toeranskelimesayisi=1 dir. İKi farklı cümleden bir kelime aynı olmaz ise aynı cümle olarak gruplar.
Buradaki değeri 2 yaparsanız 2 farklı kelimede olsa aynı cümle olarak değerlendirir.
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst