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
G2-op
7
838
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
Saako kaunis ihminen parempaa kohtelua?
Onko kauniin ihmisen elämä "helpompaa" kuin tavallisen näköisen ihmisen? Olen kuullut väittämän, että kaunis ihminen saa1012900En rehellisesti usko et oisit
Sekuntiakaan oikeasti mua kaivannut. Tai edes miettinyt miten mulla menee. Jotenkin todennäköisesti hyödyt tästäkin jos361839- 101834
Suomennettua: professori Jeffrey Sachs avaa Ukrainan sodan taustat luennollaan EU parlamentissa
Jeffrey Sachs on yhdysvaltalainen ekonomisti. Sachs toimii Columbian yliopiston The Earth Instituten johtajana. Aiemmin3861692Näin sinusta taas unta!
Unessa olin pakahtuneesti rakastunut sinuun. Olimme vanhassa talossa jossa oli yläkerran huoneissa pyöreät ikkunat. Pöly211621Nainen, olet jotenkin lumoava
Katselen kauneuttasi kuin kuuta, sen loistoa pimeässä. Sen kaunis valo on kaunista sekä herkkää ja lumoavaa. Olet naisel681457- 1191267
- 131186
En muuttaisi sinusta mitään
Ensin olit etäinen ja yritin pysyä tutkan alapuolella. Mutta ei silmiltäsi jää mitään huomaamatta, kuten minulla ei kuul91156- 201039