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
844
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
YLE Äänekosken kaupunginjohtaja saa ankaraa arvostelua
Kaupungin johtaja saa ankaraa kritiikkiä äkkiväärästä henkilöstöjohtamisestaan. Uusin häirintäilmoitus päivätty 15 kesä841656Euroopan lämpöennätys, 48,8, astetta, on mitattu Italian Sisiliassa
Joko hitaampikin ymmärtää. Se on aivan liikaa. Ilmastonmuutos on totta Euroopassakin.2691561Asiakas iski kaupassa varastelua tehneen kanveesiin.
https://www.iltalehti.fi/kotimaa/a/33a85463-e4d5-45ed-8014-db51fe8079ec Oikein. Näin sitä pitää. Kyllä kaupoissa valtava2711298Martina lähdössä Ibizalle
Eikä Eskokaan tiennyt matkasta. Nyt ollaan jännän äärellä.1691272- 56887
- 66854
Jos ei tiedä mitä toisesta haluaa
Älä missään nimessä anna mitään merkkejä kiinnostuksesta. Ole haluamatta mitään. Täytyy ajatella toistakin. Ei kukaan em65853- 41836
Miksi mies tuntee näin?
Eli olen mies ja ihastuin naiseen. Tykkään hänestä ja koskaan hän ei ole ollut minulle ilkeä. Silti ajoittain tunnen kui40831Se nainen näyttää hyvältä vaikka painaisi 150kg
parempi vaan jos on vähän muhkeammassa kunnossa 🤤44791