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

485

    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. Järkyttävä tieto Purrasta

      Purra tapasi nykyisen miehensä täällä. Suomi24:ssä! Tulipa likainen olo. Nyt loppuu tämä roikkuminen tällä palstalla.
      Maailman menoa
      242
      5546
    2. Näin asia on

      Tiedän ettei hän koskaan aio lähestyä minua eikä niin ole koskaan aikonutkaan, eikä lähesty ja enkä minä enää tee sitä k
      Ikävä
      27
      3970
    3. Taas varoitusta lumesta ja jäästä

      Ai kauhea! Vakava säävaroitus Lumi-/jäävaroitus Varsinais-Suomi, Satakunta, Uusimaa, Kanta-Häme, Päijät-Häme, Pirkanmaa,
      Maailman menoa
      19
      2354
    4. Mikseivät toimittajat vaadi Orpoa vastuuseen lupauksistaan

      Missä ne 100.000 uutta työpaikkaa muka ovat? Eivät yhtään missään. Näin sitä Suomessa voi puhua ja luvata mitä sattuu. E
      Maailman menoa
      287
      2192
    5. Aavistan tai oikeastaan

      tiedän, että olet hulluna minuun. Mutta ilman kommunikointia, tällaisenaan tilanne ja kaikki draama ovat mun näkökulmast
      Ikävä
      48
      1441
    6. Mistä erotat onko joku kiinnostunut vai muuten mukava?

      Voi sekaantua yleiseen ystävällisyyteen vai voiko?
      Suhteet
      161
      1289
    7. Poliisi tahtoo pääsyn 4 miljoonan suomalaisen sormenjälkiin.

      https://www.is.fi/digitoday/art-2000011009633.html Tämä sormenjälkiin poliisin pääsy on erittäin tärkeä rikollisten kiin
      Maailman menoa
      132
      1182
    8. Örebro kuolleet lisääntyy.

      Nyt n, 10. Mitähän vielä. Haavoittuneet?. Kuka on ampuja, salaisuus.
      Maailman menoa
      127
      1109
    9. Sulla on upeat pakarahalihakset

      todella hyvä muoto...
      Ikävä
      35
      963
    10. J. Et tullut.

      Ei se mitään. Perjantaina tulee joku muu. M.
      Ikävä
      164
      846
    Aihe