kunden Function EtsiJaSiirrä

Makro-Marko

http://keskustelu.suomi24.fi/node/9032804#comment-43879360

Nyt olis sellainen pulma etten ymmärrä. Tuo hakee arvoa 11 sheet1:stä ja jos vastine löytyy siirtää koko rivin Sheet2:n. Ookkei hyvä, mutta jos haluan siirtää sheet1 sarakkeesta A hakuehdolla 11 kaikki rivit Sheet2:n mutta en A sarakkeeseen vaan O sarakkeeseen niin eipä onnistu kun ei tajuu.

Yritin muuttaa näitä muka sopiviksi
("Sheet2!A65536") >>("Sheet2!O65536")
Offset(1, 0) >> Offset(1, 15)
LookIn:=xlValues, _ xlformulas
LookAt:=xlWhole, _xlPart

Ja tein mixailut ristiin rastiin.

Mutta ei onnaa, se siirtää aina rivit sarakkeeseen A. Miksi?


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

6

407

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Makro-Marko
      • en ollut varma halusitko siirtää vain A-sarakkeen vaiko sarakkeiden A-N tiedot, joten fiksasin molemmat...


        Option Explicit
        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
        'oletuksena, että siirrettävät tiedot sarakkeissa A-N
        Dim solu As Range
        Dim solulaajennus As Range
        Dim EkaOsoite As String
        Worksheets("Sheet1").Activate
        With Range("A:A")
        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
        Set solulaajennus = solu.Resize(1, 14)
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solulaajennus)
        Set solu = .FindNext(solu)
        Set solulaajennus = solu.Resize(1, 14)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim alue As Areas
        Dim Alueetlkm As Integer
        Dim i As Integer
        Dim Ylärivi As Long
        Dim Vasensarake As Long
        Dim YläVasen As Range
        Dim KopioitavatAlueet() As Range

        On Error GoTo virhe
        Range("Sheet2!O:AB") = ""
        Set Löydetty = EtsiJaSiirrä(11)
        Alueetlkm = Löydetty.Areas.Count
        ReDim KopioitavatAlueet(1 To Alueetlkm)
        For i = 1 To Alueetlkm
        Löydetty.Areas(i).Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
        Next
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Function EtsiJaSiirrä2(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("Sheet1").Activate
        With Range("A:A")
        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ä2 = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        Sub Testi2()
        Dim Löydetty As Range
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä2(11)
        Range("Sheet2!O:O") = ""
        Löydetty.Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub


      • Makro-Marko
        kunde kirjoitti:

        en ollut varma halusitko siirtää vain A-sarakkeen vaiko sarakkeiden A-N tiedot, joten fiksasin molemmat...


        Option Explicit
        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
        'oletuksena, että siirrettävät tiedot sarakkeissa A-N
        Dim solu As Range
        Dim solulaajennus As Range
        Dim EkaOsoite As String
        Worksheets("Sheet1").Activate
        With Range("A:A")
        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
        Set solulaajennus = solu.Resize(1, 14)
        Do
        Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solulaajennus)
        Set solu = .FindNext(solu)
        Set solulaajennus = solu.Resize(1, 14)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim alue As Areas
        Dim Alueetlkm As Integer
        Dim i As Integer
        Dim Ylärivi As Long
        Dim Vasensarake As Long
        Dim YläVasen As Range
        Dim KopioitavatAlueet() As Range

        On Error GoTo virhe
        Range("Sheet2!O:AB") = ""
        Set Löydetty = EtsiJaSiirrä(11)
        Alueetlkm = Löydetty.Areas.Count
        ReDim KopioitavatAlueet(1 To Alueetlkm)
        For i = 1 To Alueetlkm
        Löydetty.Areas(i).Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
        Next
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Function EtsiJaSiirrä2(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("Sheet1").Activate
        With Range("A:A")
        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ä2 = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        Sub Testi2()
        Dim Löydetty As Range
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä2(11)
        Range("Sheet2!O:O") = ""
        Löydetty.Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Kiitos. Ei tainnut mennä kun viikko kun itse yritin pari tuntia päivässä ratkaista siirtoa siis noilla linkin jutuilla, eikä onnannut tai onnistui mutta aina A sarakkeeseen.
        Nyt on hyvä kun pystyy tekemään vaikka mitä siirtoja, HYVÄ Functio ja koodit!!!

        Saisko vielä yhden vinkin, miksi ja mitä tarkoittaa Option Explicit.
        Kun se joskus laitetaan moduliin ja joskus ei, Miksi, mitä se tekee?


      • ...
        Makro-Marko kirjoitti:

        Kiitos. Ei tainnut mennä kun viikko kun itse yritin pari tuntia päivässä ratkaista siirtoa siis noilla linkin jutuilla, eikä onnannut tai onnistui mutta aina A sarakkeeseen.
        Nyt on hyvä kun pystyy tekemään vaikka mitä siirtoja, HYVÄ Functio ja koodit!!!

        Saisko vielä yhden vinkin, miksi ja mitä tarkoittaa Option Explicit.
        Kun se joskus laitetaan moduliin ja joskus ei, Miksi, mitä se tekee?

        Option Explicit tarkoittaa, että muuttujat on määriteltävä esim dim z as integer.


      • Makro-Marko
        ... kirjoitti:

        Option Explicit tarkoittaa, että muuttujat on määriteltävä esim dim z as integer.

        tänks


      • Makro-Marko kirjoitti:

        tänks

        että homma toimii...
        Ko funktio on todella monipuolinen, mutta sehän perustuukin Range- objektiin, mikä on mitä monipuolisin objekti Excelin kirjastossa. Soveltamalla saa aikaiseksi uskomattomia juttuja parin rivin koodilla ...

        Tattista vaan
        Keep Excelling
        @Kunde


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Persuja tuntuu kiinnostavan vain muiden rahat

      En muista kenenkään muun olleen huolissaan yhtä paljon muiden rahoista kuin persujen. Mistähän se kertoo?
      Maailman menoa
      69
      2519
    2. Järkevä ehdotus: reilun 8 miljardin euron veronkorotukset

      Nykyinen hallitus on päästänyt valtion tulopuolen rappeutumaan, vaikka varallisuutta on Suomessa enemmän kuin koskaan. U
      Maailman menoa
      84
      2394
    3. Miksei asevelvollisuuden kuluja lasketa Nato-menoihin?

      Koskela (vas) kysyy aiheellisesti, että kun kerran palkka-armejaan perustuvat maat laskevat kysesestä toiminnasta aiheut
      Maailman menoa
      17
      2140
    4. Purralla luistaa hihna isolla pyörällä

      Näki taas eilisillan tv-tentissä kuinka paniikissa oli kannatusromahduksen takia. Ei saanut kuin tiuskittua yksittäisiä
      Maailman menoa
      44
      1791
    5. Antti Lindtman heikko johtaja - ei valtiomiesainesta lainkaan

      kyllä se eilen taas nähtiin. Ei pystynyt Antti vastaamaan edes toimittajan yhteen yksinkertaiseen kysymykseen - juu tai
      Maailman menoa
      87
      1755
    6. Miksi vasemmisto ei vastusta ulkomaisen halpatyövoiman maahantuontia

      joka heikentää suomalaisten duunarien työmarkkina-asemaa ja rasittaa Suomen julkista taloutta? Vasemmistolla ideologin
      Maailman menoa
      117
      1697
    7. Miksi kaikki avioeronneet miehet eivät kunnioita naisia?

      Niin. Miksi avioeronneet miehet kohtelevat huonosti naisia, jotka lähestyvät heitä? Tämä on kokemuksen rintaääntä. Tämä
      Sinkut
      258
      1605
    8. Mitä koululla tapahtui?

      Onks kellää mitää vinkkilöit miks helikopteria tarvittii vuoksenniskan koulul https://www.is.fi/kotimaa/art-200001193287
      Imatra
      25
      1067
    9. Persuilla kannatusromahdus - enää 13,5%.

      Ylen tuorein puolueiden kannatusmittaus kertoo, että persujen kannatus on enää 13,5 prosenttiyksikköä. Kepu on mennyt he
      Perussuomalaiset
      322
      994
    10. Haluat nainen torjua minut

      Yhä uudelleen ja uudelleen. Huomaan sen. Ymmärrän miksi, mutta silti se sattuu. Eihän minulla ole muuta kuin haaveet si
      Ikävä
      9
      887
    Aihe