Hakukaava hakusessa

hakufunktioita.osaamaton

Taulukossa on noin 100 riviä. Sarakkeissa A-B on tekstiä joka rivillä, tosin näillä sarakkeilla ei ole ongelmani suhteen merkitystä. Sarakkeissa C-L joillakin riveillä ei ole mitään, joillakin on tekstiä vain sarakkeessa C, joillakin C-D, joillakin C-E jne. Rivillä ei siis ole kuitenkaan koskaan tyhjiä soluja tekstisolujen välissä, vaan rivin sisällä solut on täytetty järjestyksessä vasemmalta oikealle. Tekstiä sisältävien C-solujen teksti päättyy aina .1, D-solujen .2 jne. L-solussa on .10, siis esim. C3 voisi olla KISSA.1, D3 KOIRA.2, E3 KULTAKALA.3, F3 KILPIKONNA.4. Sama teksti voi esiintyä monella rivillä ja tuota muuttuvaa loppunumeroa lukuunottamatta eri sarakkeissa: J5 voisi olla vaikka HAMSTERI.8 ja K6 voisi olla HAMSTERI.9. Samaa tekstiä ei ole kuitenkaan samalla rivillä kahdesti.

Ongelma ratkaistavaksi: pitäisi etsiä, mikä teksti esiintyy kaikista useimmin sellaisilla riveillä, joissa C-sarakkeessa EI ole tietty annettu teksti. Ja laskennassa ei pidä ottaa huomioon tuota pisteen jälkeistä numeroa. Eli jos vertailutekstinä olisi vaikka PAPUKAIJA, pitäisi tutkia esiintyykö KISSA vai KOIRA vai HAMSTERI vai mikä useimmin sellaisilla riveillä, joiden C-solussa ei lue PAPUKAIJA.1., kun esim. KISSAksi lasketaan KISSA.1, KISSA.2....KISSA.10. Eri tekstivaihtoehtoja, joiden välillä tätä vertailua siis tehdään, on muutamia kymmeniä.

Osaako joku kehittää tähän jonkinlaisen hakufunktiokaavan tms.?

7

478

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Kundepuu

      muuta nimet ja solut sopivaksi
      Nyt solusssa N1 kelpoisuusehto ja eläimet on soluissa Q1:QXXX ja kpl sarakeessa R.
      Jos haluat makron toimivan automaattisesti lisää alla oleva jälkimmäinen koodi sitten ko.taulukon moduuliin

      tavalliseen moduuliin...

      Option Explicit
      Dim Löydetty As Range
      Dim Löydetty2 As Range
      Dim KäännettyAlue As Range
      Dim KäännettyAlue2 As Range
      Dim vika As Long
      Dim Originaali As String
      Dim a As Range
      Dim b As Range
      Dim i As Long
      Dim solu As Range
      Dim solu2 As Range
      Dim EkaOsoite As String
      Dim Alue2 As Variant
      Dim Max As Collection
      Function EtsiJaSiirrä(Hakuehto As Variant, Hakualue As Range) As Range
      'muuta taulukon nimi sopivaksi
      Worksheets("Data").Activate
      With Range(Hakualue.Address)
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlPart, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu
      EkaOsoite = solu.Address
      Do
      Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
      Set solu = .FindNext(solu)
      Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
      End If
      End With
      End Function

      Sub Testi2()
      'muuta haettava eläin solu sopivaksi, nyt N1
      Set Löydetty = EtsiJaSiirrä(Range("N1"), Range("C:C"))
      KäännäAlue (Löydetty.Address)
      End Sub

      Public Sub KäännäAlue(Alue As String)
      On Error Resume Next
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      'isonna aluetta tarvittaessa
      Set a = Range("C1:C200").SpecialCells(xlCellTypeConstants)
      Set b = Range(Alue)
      Originaali = ActiveSheet.Name

      Worksheets.Add.Name = "HuuHaa"
      Range(a.Address).Value = 1
      Range(b.Address).Clear

      Sheets(Originaali).Select (False)
      Cells.SpecialCells(xlCellTypeConstants).Select
      Worksheets("HuuHaa").Delete
      'muuta kpl-määrä sarake
      Range("R1:R3") = 0
      'muuta eläimet sarake
      vika = Range("Q65536").End(xlUp).Row
      For Each Alue2 In Selection.Areas
      For Each solu In Range("Q1:Q" & vika)
      Set Löydetty2 = EtsiJaSiirrä(solu, Alue2.Resize(, 10))
      If Not Löydetty2 Is Nothing Then
      solu.Offset(0, 1) = solu.Offset(0, 1) Löydetty2.Count
      Else
      solu.Offset(0, 1) = solu.Offset(0, 1) 0
      End If
      Next
      Next
      Range("A1").Select
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      End Sub

      ko. taulukon moduuliin...

      Option Explicit
      Private Sub Worksheet_Change(ByVal Target As Range)
      'muuta haettava eläin solu sopivaksi, nyt N1
      If Not Intersect(Range("N1"), Target) Is Nothing Then Testi2
      End Sub


      Keep EXCELing
      @Kunde

    • hakufunktioita.osaamaton

      Sepäs olikin mutkikkaampi kuin osasin kuvitella. Toimii. Suuret kiitokset.

    • vaikeuskertoimen.lisäys

      Moi.
      Minä olen pitkään yrittänyt rakentaa melkeinpä samanlaista, mutta vieläkin mutkikkaampaa systeemiä. Lähtötilanne eroaa tuosta eläin-esimerkistä siten, että minulla ei ole noita numeroita lopussa vaan pelkkiä tekstejä. Käytetään tässä nyt sitten tuota eläin-esimerkkiä mallina, niin ei tarvi koko kuvausta kirjoittaa. Osaan kyllä sitten ne solualueet sun muut muokata omaan juttuuni sopiviksi, jos tähän löytyisi koodia:
      Voisiko tuon Kundepuun kirjoittaman koodin muokata siten, että se osaisi laskea tuosta ne "kissat" tai muut elukat joiden vasemmalla puolella ei ole sitä " papukaijaa" missään sarakkeessa. Muuten siis samanlainen, mutta jos oikein älysin, niin tuossa esimerkisik solun F4 "kissa" jätetään laskematta vain silloin, kun "papukaija" on solussa C4, ja minä haluaisin että se jää laskematta aina, kun papukaija on jossain soluista C4-E4. Toisin sanoen: kun kirjoittaisin tuossa sinne N1-soluun "papukaija", se laskisi vaikkapa "kissat" sellaisilta riveiltä, joilla ei lue lainkaan "papukaijaa" plus sellaisilta riveiltä, joilla on "kissa" ennen "papukaijaa", mutta ei sellaisia "kissoja", jotka ovat "papukaijan" jälkeen (eli oikealla puolella) samalla rivillä. Ja minäkin haluaisin tietää nimenomaan sen, että mitä eläintä tuolla ehdolla löytyisi eniten.

    • Kundepuu

      Mikä sulla alueena?
      Samat C-L sarakkeet vai ?
      Haetaan C-E sarakkeista sanaa vaiko C-L sarakkeista, jos löytyy niin ennen sitä olevat lasketaan tai jos ei hakusanaa ole rivillä, niin kaikki lasketaan?

    • vaikeuskertoimen.lisäys

      Selitin tuon esimerkin näköjään epäselvästi, niin samapa tässä nyt kertoa kaikki numerotiedot, niin tulee sitten kerralla oikein:
      hakualueeni on B1:K70. Sarakkeita tosiaan juuri se 10 kuten tuossa eka jutussakin, mutta rivejä vähän vähemmän. Eri vaihtoehtoja (eri "eläimiä") on 35 kpl. Tavoitteeni olisi hakea B:K, eli lasketaan, jos hakusanaa ei ole rivillä ja lasketaan, jos on ennen hakusanaa. Ei lasketa jos on hakusanan jälkeen. Minullakaan ei ole samalla rivillä samaa sanaa kahdesti, joten yhdeltä riviltä voi tulla vain 0 tai 1 ja kun rivejä on 70, kaikki lukemat tulevat olemaan välillä 0...70.

    • Kundepuu

      Option Explicit
      Dim Löydetty As Range
      Dim Löydetty2 As Range
      Dim KäännettyAlue As Range
      Dim KäännettyAlue2 As Range
      Dim Vika As Long
      Dim Originaali As String
      Dim a As Range
      Dim b As Range
      Dim i As Long
      Dim solu As Range
      Dim solu2 As Range
      Dim EkaOsoite As String
      Dim Alue2 As Variant
      Dim Max As Collection
      Function EtsiJaSiirrä(Hakuehto As Variant, Hakualue As Range) As Range
      'muuta taulukon nimi sopivaksi
      Worksheets("Data").Activate
      With Range(Hakualue.Address)
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlPart, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu
      EkaOsoite = solu.Address
      Do
      Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
      Set solu = .FindNext(solu)
      Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
      End If
      End With
      End Function

      Sub Testi2()
      'muuta haettava eläin solu sopivaksi
      Set Löydetty = EtsiJaSiirrä(Range("M1"), Range("B1:K100"))
      KäännäAlue (Löydetty.Address)
      End Sub
      Sub LaajennaAlue()
      Dim Rivi As Range
      Dim Taulukko As Worksheet
      Dim Vika As Long
      Set Taulukko = ActiveSheet

      For i = 1 To Taulukko.UsedRange.Rows.Count
      Set Rivi = Taulukko.Rows(i)
      If WorksheetFunction.CountA(Rivi) = 0 Then
      Range("B" & i & ":K" & i).Value = 1
      Else
      Vika = Range("A" & i).End(xlToRight).Column
      Range("B" & i, Cells(i, Vika)).Value = 1
      End If
      Next i
      End Sub
      Public Sub KäännäAlue(Alue As String)
      Dim Solualue As Range
      On Error Resume Next

      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      Set a = Range("B1:K70").SpecialCells(xlCellTypeConstants)
      Set b = Range(Alue)
      Originaali = ActiveSheet.Name

      Worksheets.Add.Name = "HuuHaa"
      Range(a.Address).Clear
      Range(b.Address).Value = 1
      LaajennaAlue

      Sheets(Originaali).Select (False)

      Cells.SpecialCells(xlCellTypeConstants).Select
      Worksheets("HuuHaa").Delete
      'muuta tulos kpl-määrä sarake, nyt R-sarake
      Range("Q1:Q10") = 0
      'muuta eläimet sarake, nyt Q-sarake
      Vika = Range("P65536").End(xlUp).row
      For Each solu In Range("P1:P" & Vika)
      Set Löydetty2 = Nothing
      Set Löydetty2 = EtsiJaSiirrä(solu, Selection)
      If Not Löydetty2 Is Nothing Then
      solu.Offset(0, 1) = solu.Offset(0, 1) Löydetty2.Count
      Else
      solu.Offset(0, 1) = solu.Offset(0, 1) 0
      End If
      Next
      Range("A1").Select
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      End Sub

    • vaikeuskertoimen.lisäys

      Hienoa, kiitos.

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Nurmossa kuoli 2 Lasta..

      Autokolarissa. Näin kertovat iltapäivälehdet juuri nyt. 22.11. Ja aina ennen Joulua näitä tulee. . .
      Seinäjoki
      144
      8369
    2. Joel Harkimo seuraa Martina Aitolehden jalanjälkiä!

      Oho, aikamoinen yllätys, että Joel Jolle Harkimo on lähtenyt Iholla-ohjelmaan. Tässähän hän seuraa mm. Martina Aitolehde
      Suomalaiset julkkikset
      46
      2318
    3. Kaksi lasta kuoli kolarissa Seinäjoella. Tutkitaan rikoksena

      Henkilöautossa matkustaneet kaksi lasta ovat kuolleet kolarissa Seinäjoella. Kolmas lapsi on vakasti loukkaantunut ja
      Maailman menoa
      26
      2162
    4. Miten meinasit

      Suhtautua minuun kun taas kohdataan?
      Ikävä
      95
      1738
    5. Miksi pankkitunnuksilla kaikkialle

      Miksi rahaliikenteen palveluiden tunnukset vaaditaan miltei kaikkeen yleiseen asiointiin Suomessa? Kenen etu on se, että
      Maailman menoa
      181
      1687
    6. Et olisi piilossa enää

      Vaan tulisit esiin.
      Ikävä
      34
      1546
    7. Tunnekylmä olet

      En ole tyytyväinen käytökseesi et osannut kommunikoida. Se on huono piirre ihmisessä että ei osaa katua aiheuttamaansa p
      Ikävä
      108
      1103
    8. Taisit sä sit kuiteski

      Vihjata hieman ettei se kaikki ollutkaan totta ❤️ mutta silti sanoit kyllä vielä uudelleen sen myöhemmin 😔 ei tässä oik
      Ikävä
      5
      1019
    9. Oletko miten

      Valmis läheisyyteen?
      Ikävä
      53
      1005
    10. Sinä saat minut kuohuksiin

      Pitäisiköhän meidän naida? Mielestäni pitäisi . Tämä värinä ja jännite meidän välillä alkaa olla sietämätöntä. Haluai
      Tunteet
      16
      917
    Aihe