Löytyykö merkkijono-->kopioi rivi sheet2

G2-op

Osaako joku neuvoa?

Minulla on taulukko, jossa on rivejä n. 500 kpl ja riveillä 2-50 sarakkeita, joilla on merkkijonoja.

Haluan etsiä koko taulukosta rivi riviltä löytyykö tiettyä merkkijonoa joltakin sarakkeelta. Jos löytyy haluan kopioida kyseisen rivin sisällön kokonaisuudessaan toiseen taulukkoon ja jatkaa etsintää viimeiselle riville asti.

7

895

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      moduuliin...
      etsii nyt sheet1:stä arvoa 11 ja siirtää löydetyt rivit sheet2:lle ekalle tyhjälle riville A- sarakkeessa
      muuttele vakioita tarpeesi mukaan...
      LookIn:=xlValues-xlFormulas
      LookAt:=xlWhole-xlPart
      MatchCase:=False-True

      Function EtsiJaSiirrä(Hakuehto As Variant) As Range
      Dim solu As Range
      Dim EkaOsoite As String
      Worksheets("Sheet1").Activate
      With Cells
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu
      EkaOsoite = solu.Address
      Do
      Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
      Set solu = .FindNext(solu)
      Loop While Not solu Is Nothing And solu.Address EkaOsoite
      End If
      End With

      End Function

      Sub Testi()
      Dim Löydetty As Range
      On Error GoTo virhe
      Set Löydetty = EtsiJaSiirrä(11).EntireRow
      Union(Löydetty, Löydetty).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 0).EntireRow
      Exit Sub
      virhe:
      MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
      End Sub

      • mokasin

        mulla pysätyy tohon LookIn:= kohtaan

        mitä teen väärin

        sen lisäksi koitin muokata siten että hakee sheet1 A1 solun tietoa Sheet3 ja palauttaa Sheet1 A1 alapuolelle jos löytyy, haku on tekstiä, ja jos löytyy useampia, palauttaisi kaikki allekkain sheet1 sivulle

        LookIn:=xlValues - xlFormulas
        LookAt = xlWhole - xlPart
        MatchCase = False - True

        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaSiirrä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With

        End Function

        Sub Testi()
        Dim Löydetty As Range
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

      • kunde
        mokasin kirjoitti:

        mulla pysätyy tohon LookIn:= kohtaan

        mitä teen väärin

        sen lisäksi koitin muokata siten että hakee sheet1 A1 solun tietoa Sheet3 ja palauttaa Sheet1 A1 alapuolelle jos löytyy, haku on tekstiä, ja jos löytyy useampia, palauttaisi kaikki allekkain sheet1 sivulle

        LookIn:=xlValues - xlFormulas
        LookAt = xlWhole - xlPart
        MatchCase = False - True

        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaSiirrä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With

        End Function

        Sub Testi()
        Dim Löydetty As Range
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        ei tunnista tota R1C1 soluksi A1, all hiukan muunneltuna ja korjattuna makrot


        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaSiirrä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        Worksheets("Sheet1").Activate
        Range("A1").Select
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim Haku As Variant

        On Error GoTo virhe
        Haku = Worksheets("Sheet1").Range("A1")
        Set Löydetty = EtsiJaSiirrä(Haku).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

      • konsultointia
        kunde kirjoitti:

        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        ei tunnista tota R1C1 soluksi A1, all hiukan muunneltuna ja korjattuna makrot


        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaSiirrä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        Worksheets("Sheet1").Activate
        Range("A1").Select
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim Haku As Variant

        On Error GoTo virhe
        Haku = Worksheets("Sheet1").Range("A1")
        Set Löydetty = EtsiJaSiirrä(Haku).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Kiitti Kunde.

        Jäi laittamatta että A1 kenttään tulee tekstiä, ja vastaus / vastauksia tulisi vaikkei olisikaan kirjoittanut täysin samalla tavalla ( isot /pienet kirjaimet ) ja täydellistä sanaa, esim viiden kirjaimen mukaan, muttei välttämättä lauseen / rivin alussa vaan jossain sen sisällä.

      • kunde
        konsultointia kirjoitti:

        Kiitti Kunde.

        Jäi laittamatta että A1 kenttään tulee tekstiä, ja vastaus / vastauksia tulisi vaikkei olisikaan kirjoittanut täysin samalla tavalla ( isot /pienet kirjaimet ) ja täydellistä sanaa, esim viiden kirjaimen mukaan, muttei välttämättä lauseen / rivin alussa vaan jossain sen sisällä.

        kuten ekassa postauksessani sanoin, vaihda vakioita
        vauhda koodissa
        LookAt:=xlWhole--->LookAt:=xlPart

      • Kumarrus
        kunde kirjoitti:

        kuten ekassa postauksessani sanoin, vaihda vakioita
        vauhda koodissa
        LookAt:=xlWhole--->LookAt:=xlPart

        Nyt pelittää, mutta

        vielä jos saa niin ettei väliä onko capslock päällä.
        Jos kirjoitan ISOILLA toimii
        pienillä ei löydy

      • kiitos kundelle
        Kumarrus kirjoitti:

        Nyt pelittää, mutta

        vielä jos saa niin ettei väliä onko capslock päällä.
        Jos kirjoitan ISOILLA toimii
        pienillä ei löydy

        toimii jo olin muuttanut noi trueksi, vaihdoin takaisin.

        MatchCase:=False,
        _
        SearchFormat:=False

        olen sulle kaljan ainakin velkaa

        kiitos

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Muistatko kaivattusi

      Syntymäpäivän? Päivämäärä riittää. 🌹
      Ikävä
      126
      1710

    2. Miltä ne katseet tuntui?

      😇
      Ikävä
      105
      1195

    3. Postimerkki kirjeeseen ja kortiin maksaa jo 3 euroa!

      https://yle.fi/a/74-20229241 Kyllä tämä on järjetön hinta, Posti tuhoaa itsensä tällä hinnalla, täytyyhän Postin "Herro
      Maailman menoa
      138
      1071

    4. Mulla on ikävä

      sua nainen ja niitä katseita ❤️ Lupaatko, että katseemme kohtaa taas?
      Ikävä
      49
      979

    5. Miten pääsee ujon naisen pään sisään?

      Siis tosi tosi tosi ujon...
      Ikävä
      128
      877

    6. Keitä oli kunnanjohtajan erottajat?

      Kouluja ei ole varaa ylläpitää mutta johtajasopimukseen palaa 100000 euroa ja uuden johtajan hakuprosessi maksaa kymmeni
      Ilmajoki
      51
      870

    7. Atte Harjanne usuttaa eläkeläisvihaan

      Karmeeta kuultavaa aamun uutislähetyksessä, kun Atte Harjanne, tunnettu eläkeläisvihaaja, suitsii sukupolvien välistä v
      Maailman menoa
      240
      838

    8. Helsingin Mäntymäki muuttui Kultajuhlan jälkeen kaatopaikaksi.

      Mitä se kertoo jääkiokosta ja lätkäfaneista? Saikkua huomenna huusi fani yöllä?
      Maailman menoa
      70
      745

    9. Pridekulkue kiellettävä?

      Näin täällä suoraan vaaditaan. Perusteina mitä mielikuvituksellisimmat tarinat. No, miksi ihmeessä kukaan ei ole samalla
      Luterilaisuus
      178
      719

    10. Mä oon tyytyväinen, että ei ole enää tunteita.

      Samalla tajusin, että sun kohdalla tykkäsin enemmän niistä tunteista kuin sinusta persoonana. Halusin väkisin nähdä sinu
      Ikävä
      55
      709
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt