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
834
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
JOKO OLETTE KUULLET, MITÄ KIURUVEDELLÄ ON SATTUNUT!
Oletteko jo kuulleet, mitä Kiuruvedellä on sattunut, voi hyvänen aika? Aivan viime tuntien aikana olisi sattunut, jos t3311625Hetken jo luulin, että en ikävöi sinua koko aikaa
Mutta nyt on sitten taas ihan hirveä ikävä jotenkin. Tiedätköhän sinä edes, kuinka peruuttamattomasti minä olen sinuun r357501V*ttuu että mä haluan sua
Jos jotain ihmistä voi kunnolla haluta, niin hän on se. Voi Luoja auta jo! Joku jeesus hjelppa mej!823929Nolointa ikinä miehelle
On ghostata nainen jonka kanssa on ollut ystävä tai ollu orastavaa tapailua pidemmän aikaa. Osoittaa sellaista moukkamai1063829- 433371
Outoa että Trump ekana sanoutui irti ilmastosopimuksesta
kun Kaliforniaa riepottelee siitä johtuvat tuhoisat maastopalot. Hirmumyrskytkin ovat USA:ssa olleet tuhoisia.6113237Eli jos toisen hiki haisee ns. omaan nenään siedettävältä
Se kertoo hyvästä yhteensopivuudesta. Selvä! Olet mies minun. 🫵🥳523212- 913098
Sattuma ja muutama väärinkäsitys
vaikuttivat siihen millaiseksi tämä kaikki muodostui. Pienet aikanaan huomaamattomat käänteet. Seuraava näytös on jo tul322033- 361910