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

149

Ää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. Anna vielä vähän vihreää valoa

      Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet
      Ikävä
      28
      1748

    2. Syksyinen aamuketju suden

      Hyvää huomenta ja kaunista syyspäivää. 🌞🍁🍂☕
      Ikävä
      227
      1160

    3. Koulu kielsi therianit - "tunneilla kontataan ja nau'utaan"

      Oululainen koulu on kieltänyt eläin- ja rooliasujen käytön koulussa. Hyvä homma, sillä koulussa keskitytään muihin asioi
      Maailman menoa
      105
      799

    4. Triatleetti osti Levin

      Mun Lappi on tosiasia.
      Kotimaiset julkkisjuorut
      180
      777

    5. Onhan se myönnettävä

      Että alkaa jo vähän puuduttamaan tämä. Aion silti ottaa tästä kaiken irti viimeisiä rippeitä myöden. Olenpa sitten suju
      Ikävä
      51
      760

    6. Astuin tuntemattomaan

      kun sinut tapasin, sieluni valo. Niin olen paljaaksi riisuttu kuin syksyiset puut.
      Ikävä
      50
      742

    7. Rakastan sinua niin paljon

      Kun ollaan tutustuttu lisää niin se rakkaus ei ole vähentynyt vaan muuttunut. Jännitys on vähentynyt ja tilalle on tullu
      Ikävä
      40
      710

    8. Enemmistön diktatuuri Ähtärin valtuustossa

      Salo ja Nortunen, ette saa keikuttaa venettä. Olette mätiä omenoita, jotka pitää poimia pois Ähtärin kaupunginhallitukse
      Ähtäri
      22
      710

    9. Taisit vähän aliarivoida minua ihmisenä

      Et tajunnut että olenkin aika nokkela tyttö 🤭 Jutut ja ulkonäkö varmaan hämäs.
      Ikävä
      35
      686

    10. Mulla on ihan hirveä ikävä sua

      Ja sitten kun me taas nähdään, tai jos, niin mua vaan pelottaa että sinä inhoat sitä että mulla on tunteita sinuun.
      Ikävä
      47
      679
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt