Minulla on A-sarakkeessa tietoa ja pitäisi saada etsittyä tietty aloitusmerkki esim ~290 ja poimittua sitä seuraavat merkit lopetetusmerkkiin asti (esim ~291) toiseen taulukkoon. Jos tieto olisi samalla rivillä, niin osaisin hakea ne, mutta näin en osaa. Eli alla olevasta esimerkistä pitäisi saada poimittua 430, 429, 439 ja 450 toiseen taulukkoon:
A
1 610
2 ~290
3 430
4 429
5 439
6 450 ~291
7 500
8 550
Sarakkeittainen tietojen poiminta
3
149
Vastaukset
muotoile sopivaksi ...
esim. nyt
hakee Taul1 A -sarakkeesta solunjen E1 ja E2 väliset luvut TAul2 A-sarakkeeseen...
aloitusehto solussa E1
lopetusehto solussa E2
Sub HakuEhdoilla()
On Error Resume Next
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim solu As Range
Dim vika As Long
Set Löydetty = Etsi(Chr(126) & Range("E1"))
Set Löydetty2 = Etsi(Chr(126) & Range("E2"))
Range(Löydetty.Offset(1, 0).Address & ":" & Löydetty2.Address).Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
vika = Worksheets("Taul2").Range("A65536").End(xlUp).Row
Worksheets("Taul2").Range("A" & vika) = Left(Worksheets("Taul2").Range("A" & vika), InStr(1, Worksheets("Taul2").Range("A" & vika), "~", 1) - 1)
End Sub
Function Etsi(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul1").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set Etsi = solu
End If
End With
End Function
Keep EXCELing
@Kunde- teme34
Hei, tämä oli mielenkiintoinen ja toimiva ratkaisu!
Entä jos A-sarakkeella on useampia saman alku- ja lopetusmerkin omaavia kohteita, joiden välit halutaan poimia. Oletuksena näiden määrää ei tiedetä.Ruokahalu kasvaa syödessä näköjään...
nyt ei väliä montako samaa aluetta löytyy...
Function Etsi(Hakuehto As Variant) As Range
'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
'oletuksena, että haettavat tiedot vain sarakkeessa A
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul1").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set Etsi = solu
EkaOsoite = solu.Address
Do
Set Etsi = Union(Etsi, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Sub HakuEhdoilla()
On Error Resume Next
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim solu As Range
Dim vika As Long
Set Löydetty = Etsi(Chr(126) & Range("E1"))
Set Löydetty2 = Etsi(Chr(126) & Range("E2"))
If Löydetty.Areas.Count = Löydetty2.Areas.Count Then
For i = 1 To Löydetty.Areas.Count
Range(Löydetty.Areas(i).Cells(1, 1).Offset(1, 0).Address & ":" & Löydetty2.Areas(i).Cells(1, 1).Address).Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
vika = Worksheets("Taul2").Range("A65536").End(xlUp).Row
Worksheets("Taul2").Range("A" & vika) = Left(Worksheets("Taul2").Range("A" & vika), InStr(1, Worksheets("Taul2").Range("A" & vika), "~", 1) - 1)
Next
Else
MsgBox "Ristiriita alueiden kanssa"
End If
End Sub
Keep EXCELing
@Kunde
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 1763501
Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.1122259Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...1462257- 992077
- 901734
Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet281698- 781222
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv2951187- 2271150
- 74988