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

201

Ää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. Natomaa hyökkäsi Iraniin

      Näemme nyt tällä hetkellä Natomaan nimeltä Yhdysvallat, joka toimii aika pitkälti perinteisen kansainvälisen lain ulkopu
      NATO
      719
      3174

    2. Trump aloitti III maailmansodan tänään.

      Narsisti ja mielipuoli Trump pitäisi saada pois, miten se onnistuisi parhaiten?
      Maailman menoa
      362
      2882

    3. Suvi Lindenillä 5 366 päivän putki

      Täytyy kyllä myöntää vaikka olen itsekin innokas, niin en ole tuollaiseen yli kymmenen vuoden putkeen kyennyt. Välillä o
      Maailman menoa
      69
      2698

    4. Mistä se kertoo

      Näin miehen pitkästä aikaa. Samantien iski sellainen paineen tunne rintaan, sitä ei ole ollut vuosiin. Ja nyt olen siitä
      Ikävä
      34
      2606

    5. Rakas tiedät, että toivoisin

      Kuulevani sinusta. Tiedät, että viestisi tekisi minut ihan onnelliseksi. Että äänesi kuuleminen saisi minut leijumaan ja
      Ikävä
      58
      2118

    6. Eräs on taas viettänyt kokoyön täällä!!

      Etkö sä nuku koskaan??
      Ikävä
      49
      1669

    7. Miksi rakastuit

      Kaivattuusi?
      Ikävä
      83
      1648

    8. Viesti miehelle

      Nyt vastaa oikea taa´app. Ainoastaan puhelimitse voidaan selvittää asioita, mutta tuskin sitä haluat kaiken halveeramise
      Ikävä
      13
      1641

    9. Nyt on sanottava että sattuu kipeästi

      Jos, sinä aikana kun olen kaivannut ja odottanut sinua ja olet tiennyt sen, niin jos valitsit toisen miehen. Katsot minu
      Ikävä
      18
      1639

    10. Teit asiat lopulta niin

      Ettei meillä ole ikinä mitään mahdollisuuksia toisiimme.
      Ikävä
      57
      1529
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt