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

392

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Makro-Marko
      • kunde

        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

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Mikaela Nylander: Jos pakkoruotsi poistetaan, niin ruotsin kielen asema romahtaa

      (Nylander on vanha RKP:nen) Mutta niin heikossa vedossa muumiruotsi siis on Suomessa, että vain tekohengityksellä se pys
      Maailman menoa
      65
      2572

    2. Nainen aion pilata elämäsi täysin, opetus sulle, että pelasit väärän ihmisen sydämellä.

      Empatiani sua kohtaan katosi siinä kohtaan, kun teit tietoisen valinnan leikkiä mun sydämellä. Luulet olevas joku älykäs
      Ikävä
      241
      1585

    3. Kaivattusi nimi vol.3

      Kaipaajankin nimi olisi kiva. 🥰
      Ikävä
      94
      1380

    4. 6 vkoa kulunut ilman sua

      …ihme että olen vielä hengissä. 😔 Kyynelillä pessyt lattioita. Rakastan ja odotan sua ikuisesti❤️Projekti jäi kesken jo
      Ikävä
      8
      901

    5. Viestisi kaipaamallesi ihmiselle

      Mitä ajattelet tilanteestanne tänään?
      Ikävä
      65
      882

    6. Jotenkin se harmittaa

      Etten voinut antaa itselleni mahdollisuutta tutustua. Tulit vain liian lähelle ja syvälle kemia oli alusta alkaen liian
      Ikävä
      46
      700

    7. Olen yrittänyt tavoittaa sinut kolmesti

      Elämän aikana. Kahdesti hakenut numeroa ja lähettänyt jollekkin nimisellesi viestin. Kerran aivan summassa keksimääni os
      Ikävä
      2
      652

    8. Haluan kysyä vain yhden asian

      Miksi et koskaan halunnut kohdata minua kasvotusten silloin, kun molemmilla oli tunteita? Kaiken muun olen jo hyväksymäs
      Ikävä
      39
      579

    9. Mies aion pilata elämäsi

      Ole hyvä vaan, olet ansainnut sen.
      Ikävä
      73
      562

    10. Kauneus on katsojan silmissä

      Mitä kaunista sun silmät näkevät?
      Ikävä
      22
      512
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt