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

259

Ää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. Vesikin maksaa, miksei hengitysilma?

      Jatkuvasti itketään ettei ole rahaa mihinkään, mutta tilastojen mukaan rahaa on enemmän kuin koskaan, joten miksei asial
      Maailman menoa
      34
      1962

    2. Satuolennoista tarinointi ei kuulu peruskoulun tehtäviin

      Opetustunteja on muutenkin käytössä vain rajallinen määrä. Eli nämä satuhommat koulun ulkopuolelle vapaaehtoisiin harras
      Maailman menoa
      165
      1890

    3. Suomalainen perheenisä vaatii Suvivirren esittämisestä hyvityksiä

      Itse lapsena uskonnonopetuksesta vissiin traumoja saanut ihka suomalainen (!) perheenisä vaatii Espoon kaupungilta korva
      Maailman menoa
      382
      1792

    4. Mies profiloin sinut

      Etsit täysin hallittavaa mutta samalla poikkeuksellista ihmistä. Etsit jotain mitä et koskaan tule saamaan.
      Ikävä
      216
      1248

    5. Nostetaanko nainen kissa pöydälle?

      Ja selvitetään nämä tunteet?
      Ikävä
      92
      1123

    6. Kiantama kartelli

      Onko alhaisempaa kuin toimia ensin kartellissa ja lopuksi koittaa pelastaa nahkasa vasikoimalla muut kun jää kiinni? Eip
      Suomussalmi
      34
      970

    7. Oletko ollut *ittupää

      Siinäpä se kysymys eli oletko ollut *ittupää hänelle? Miksi?
      Ikävä
      95
      765

    8. Kiantama oy

      Tämän päivän uutiset.....https://www.is.fi/taloussanomat/art-2000012036470.html.
      Suomussalmi
      15
      698

    9. Haluaisin nähdä ja tavata sinut mies

      Vielä tässä elämässä.
      Ikävä
      32
      674

    10. Saako 60 v vielä töitä? Arto Nyberg puhuu suoraan elämästä ilman töitä

      Arto Nyberg täyttää tänään 60 v. Onnea! Nyberg totuttiin näkemään suoran haastatteluohjelman kapteenina vuodesta toise
      Maailman menoa
      47
      665
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt