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.
Löytyykö merkkijono-->kopioi rivi sheet2
7
885
Vastaukset
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 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 SubSet 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 SubKiitti 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ä. 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:=xlPartNyt 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öydytoimii 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ä.
Luetuimmat keskustelut
Riikka Purran kaudella nousi bensan hinta yli 2 euron
Muistatteko kuinka edellisen vasemmistohallituksen aikana, ns. Marinin aikakaudella, bensiiniä sai 1,3 euron litrahinnal1625011Veli Sofia teki urosmehiläisen työn
Paljastaessaan kuinka TPS:ssä ei joukkuehenki toimi sooloilijoiden vuoksi, jonka takia koko seura ei pärjää kilpailussa203611Mitäs nyt sijoittajat?
Pörssit laskevat maailmalla Iranin sodan takia ja muutenkin ovat olleet Trumpin vallan alla epävarmat. Ainoa, mikä on no1623419Hjallis Harkimon, 72, Jasmine-rakas, 37, paljastaa suhteen alusta: "Vähän..."
Liikemies, kansanedustaja Hjallis Harkimo ja tuottaja-juontaja Jasmine Pajari ovat pariskunta. He asuvat yhdessä Sipooss382917Unisex-vessat
Ahdistaa. Miksi kaikki pitää tasapäistää tasa-arvon nimissä? Tasa-arvo on sitä, että kunnioitetaan sukupuolien erilaisu1072679Sosiaalidemokratia romahtanut kautta maailman
nuoret eivät enää kannata järjetöntä aatetta, joten demarien täytyy hakea kannattajia mamuista. Ruotsin sos.demit jo kie282058Jutta Larm, 52, haluaa kumota tämän piintyneen ikämyytin
Oletko samaa mieltä? Jutta Larm on 52-vuotias ja tehnyt pitkän uran yrittäjänä. Hän haluaa kumota tämän piintyneen ikämy191905Jäit kiinni siitä
että katselet minua. Käänsin pääni, minäkin etsin sinua, ja meidän katseemme kohtasivat. Eikä se haittaa - molemmat ky111789Vastuun ottaminen omasta hyvinvoinnista
Olen huomannut tuttavapiirissäni ihmisiä, joilla on mt-diagnooseja. Sen sijaan, että millekään asialle yritettäisiin teh1551522Henri Alen tilittää yllättäen Vappu Pimiän uudesta MasterChef -pestistä: "Vaikka hän ei..."
Vappu Pimiä on uusi MasterChef Suomi -tuomari. Hän liittyi uudella MasterChef Suomi -kaudella arvovaltaiseen tuomaristoo111502