Sarakkeittainen tietojen poiminta

ssssssssssd

Minulla on A-sarakkeessa tietoa ja pitäisi saada etsittyä tietty aloitusmerkki esim ~290 ja poimittua sitä seuraavat merkit lopetetusmerkkiin asti (esim ~291) toiseen taulukkoon. Jos tieto olisi samalla rivillä, niin osaisin hakea ne, mutta näin en osaa. Eli alla olevasta esimerkistä pitäisi saada poimittua 430, 429, 439 ja 450 toiseen taulukkoon:

A
1 610
2 ~290
3 430
4 429
5 439
6 450 ~291
7 500
8 550

3

221

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      muotoile sopivaksi ...
      esim. nyt

      hakee Taul1 A -sarakkeesta solunjen E1 ja E2 väliset luvut TAul2 A-sarakkeeseen...

      aloitusehto solussa E1
      lopetusehto solussa E2

      Sub HakuEhdoilla()
      On Error Resume Next
      Dim Löydetty As Range
      Dim Löydetty2 As Range
      Dim solu As Range
      Dim vika As Long
      Set Löydetty = Etsi(Chr(126) & Range("E1"))
      Set Löydetty2 = Etsi(Chr(126) & Range("E2"))
      Range(Löydetty.Offset(1, 0).Address & ":" & Löydetty2.Address).Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
      vika = Worksheets("Taul2").Range("A65536").End(xlUp).Row
      Worksheets("Taul2").Range("A" & vika) = Left(Worksheets("Taul2").Range("A" & vika), InStr(1, Worksheets("Taul2").Range("A" & vika), "~", 1) - 1)
      End Sub

      Function Etsi(Hakuehto As Variant) As Range
      Dim solu As Range
      Dim EkaOsoite As String
      Worksheets("Taul1").Activate
      With Range("A:A")
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlPart, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set Etsi = solu
      End If
      End With
      End Function

      Keep EXCELing
      @Kunde

    • teme34

      Hei, tämä oli mielenkiintoinen ja toimiva ratkaisu!

      Entä jos A-sarakkeella on useampia saman alku- ja lopetusmerkin omaavia kohteita, joiden välit halutaan poimia. Oletuksena näiden määrää ei tiedetä.

      • kunde

        Ruokahalu kasvaa syödessä näköjään...
        nyt ei väliä montako samaa aluetta löytyy...

        Function Etsi(Hakuehto As Variant) As Range
        'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
        'oletuksena, että haettavat tiedot vain sarakkeessa A
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Taul1").Activate
        With Range("A:A")
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set Etsi = solu
        EkaOsoite = solu.Address
        Do
        Set Etsi = Union(Etsi, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        Sub HakuEhdoilla()
        On Error Resume Next
        Dim Löydetty As Range
        Dim Löydetty2 As Range
        Dim solu As Range
        Dim vika As Long
        Set Löydetty = Etsi(Chr(126) & Range("E1"))
        Set Löydetty2 = Etsi(Chr(126) & Range("E2"))
        If Löydetty.Areas.Count = Löydetty2.Areas.Count Then
        For i = 1 To Löydetty.Areas.Count
        Range(Löydetty.Areas(i).Cells(1, 1).Offset(1, 0).Address & ":" & Löydetty2.Areas(i).Cells(1, 1).Address).Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
        vika = Worksheets("Taul2").Range("A65536").End(xlUp).Row
        Worksheets("Taul2").Range("A" & vika) = Left(Worksheets("Taul2").Range("A" & vika), InStr(1, Worksheets("Taul2").Range("A" & vika), "~", 1) - 1)
        Next
        Else
        MsgBox "Ristiriita alueiden kanssa"
        End If
        End Sub

        Keep EXCELing
        @Kunde

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Kuinka Riikka Purra on parantanut Suomen kansalaisen elämää?

      Haastan kaikki perussuomalaisten kannattajat kertomaan konkreettisia esimerkkejä kuinka Riikka Purran harjoittama politi
      Maailman menoa
      78
      3832

    2. Iso poliisioperaatio Lapualla

      Paikalla oli silminnäkijän mukaan myös kolme ambulanssia. https://www.is.fi/kotimaa/art-2000011924650.html Onko virpo
      Lapua
      64
      3574

    3. Diesel-ammattilainen kehuu Sanna Marinia

      "Sanna Marinin (sd) hallitus loi neljä vuotta sitten väliaikaisen polttoaine­tuki­järjestelmän, kun energianhinnat nousi
      Maailman menoa
      47
      3217

    4. Pitkänperjantain kunniaksi tekoälyn analyysi Riikka Purran kirjoituksesta

      🧠 Mitä se kertoo "riikka"-nimimerkin lähijunassa tapahtuneesta? 1. Asenteellinen ja epäasiallinen sävy: Kirjoitus purs
      Maailman menoa
      64
      3030

    5. 100 prosentin perintövero korjaisi myös Hitas-ongelman

      Moni ei uskalla kieltäytyä perinnöstä maineen menettämisen uhalla, joten sitten tulee näitä tilanteita, joissa joutuu es
      Maailman menoa
      56
      2625

    6. Riikan antisakset leikkaavat bensan hintaa ylöspäin

      Sannan aikoina bensaa sai 1,3 euron litrahinnalla ja Riikka leikkasi sen euron ylemmäksi reiluun 2 euroon. Joko on saks
      Maailman menoa
      37
      2187

    7. Sukupuolineutraalit liikennemerkit yksi persujen älynväläys

      Samassa rytäkässä kaikki syrjäseutujen bussipysäkkien liikennemerkitkin vaihdettiin, vaikkei bussia ole liikennöinyt enä
      Maailman menoa
      52
      2149

    8. Olen aika varma

      että meidän tiemme risteäminen oli ainutkertainen tapahtuma elämässäni. En tule koskaan kohtaamaan ketään muuta, joka sa
      Ikävä
      61
      2037

    9. Oletko nähnyt hänet ilman...

      Vaatteita!?
      Ikävä
      53
      1981

    10. Oon niin surullinen

      Ettei meistä tullut sitä mitä toivoin
      Ikävä
      51
      1726
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt