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

383

    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. Mieleni harhailee sinussa

      Uskon että tykkäät minusta. On vain yksi elämä. Silti jään paikoilleni ja odotan että jokin muuttuu. Menin palasiksi, ei
      Tunteet
      21
      5604
    2. Taposta murhaksi

      Mitä tästä tapauksesta tiedetään?
      Kajaani
      53
      1685
    3. Grilli lopettaa?

      Pitääkö huhu paikkaansa että grilli lopettaa lähiaikoina?
      Suomussalmi
      21
      1153
    4. Pitääkö luovuttaa?

      Sano nyt edes jotain 👾
      Ikävä
      69
      1017
    5. Mitä teet nainen

      Jos saat tietää että mies on elänyt yksinäistä ja rauhallista elämää sinua kaivaten, ei ole ollut muiden naisten kanssa,
      Ikävä
      53
      987
    6. Joko Martinalla uusi aviomies hakusessa

      Onko jo Raya sovellukseen laitettu uusi vetoomus vetämään... ja mistähän maasta mahtaa olla seuraava sulhasehdokas. Suom
      Kotimaiset julkkisjuorut
      162
      958
    7. Olet nuorempi nainen aivan ihana

      Tykkään susta ihan valtavasti ❤️❤️
      Ikävä
      48
      908
    8. Mitä vastaisit

      Jos kysyisin, että lähdettäisiinkö lenkille yhdessä? Vain sinä ja minä, kaksin? Miehelle
      Ikävä
      57
      900
    9. Pitkäaikaistyöttömyys Suomessa harvinaisen paha

      Karut työttömyysluvut, korkein luku yli neljännesvuosisataan.
      Maailman menoa
      123
      896
    10. Missä olitte kun oli teidän tähän saakka kaunein yhteinen hetki?

      Me olimme rannalla erään kiven päällä❤️
      Ikävä
      58
      858
    Aihe