Sarakkeittainen tietojen poiminta

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

178

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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ä.

      • 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ä.

    Luetuimmat keskustelut

    1. 20v on otettu kiinni

      Tulipalo oli sytytetty joten murhasiko ex omat lapsensa ja heidän Äidin. Tuskin sitä kukaan ohikulkijakaan sytytti.
      Savonlinna
      382
      13562
    2. Näin tyhmä vasemmistolainen on: "S-kaupoissa on nykyään ihanaa käydä

      kun siellä ei ole hihhuleita eikä persuja." Vain tyhmä eli heikkoälyinen vasemmistolainen voi tehdä noin lapsellisia ju
      Maailman menoa
      52
      4296
    3. S-kaupoissa on nykyään ihanaa käydä

      Kun niissä ei enää käy satuolentoihin uskovat hihhuIit eivätkä persut. Asiakaskunta on huomattavasti siistiytynyt muutam
      Maailman menoa
      109
      4113
    4. Riikka runnoo! Uutta velkaa tänä vuonna 17 mrd. euroa

      Tirsk. Nyt kyllä hihityttää kuin pientä eläintä. Riikka takoo maailmanennätyksiä tasaiseen tahtiin. " [Riikka] joutuu
      Maailman menoa
      36
      4050
    5. Suomessa on ollut suurtyöttömyyttä ennenkin, ja lääkäriin pääsee nykyäänkin

      Täällähän oli jonkun sekopään(vas.) juttu, että ennen ei ollut työttömyyttä ja lääkäriin pääsi. Siihen alkoi tietysti ko
      Maailman menoa
      63
      3891
    6. Mitä meidän välillä

      Tapahtuu lopulta?
      Ikävä
      85
      3344
    7. 105
      3232
    8. Kysymys: Kuinka moneen maahan neuvosto-venäjä on hyökännyt

      viimeisten 90-vuoden aikana? Ja lähinnä on siis kyse neuvosto-venäjän naapurimaista - kuten Suomesta. Lista on huomatta
      Maailman menoa
      64
      3218
    9. IL - Auerin lapsia oli houkuteltu rahalla Annelin puolelle?

      16:12 Outoja väitteitä Sijaisäidin mukaan Auerin lapsia koetettiin houkutella nettipalstoilla muuttamaan kertomuksiaan
      Maailman menoa
      145
      3189
    10. Savonlinan perhesurma, epäilty mies romani, äiti kantaväestöä

      https://www.is.fi/kotimaa/art-2000011676508.html Savonlinnan seudun romaniyhdistyksestä kerrottiin lauantaina IS:lle, e
      Maailman menoa
      160
      2941
    Aihe