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

405

Ää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. Eutanasia - miksi eläimelle sallitaan armokuolema, mutta ihmiselle ei?

      Olen pitkään ihmetellyt yhtä asiaa Suomessa. Kun koira kärsii parantumattomasta sairaudesta ja kovista kivuista, eläinlä
      Arvot ja etiikka
      26
      11481

    2. Veli Sofia teki urosmehiläisen työn

      Paljastaessaan kuinka TPS:ssä ei joukkuehenki toimi sooloilijoiden vuoksi, jonka takia koko seura ei pärjää kilpailussa
      Maailman menoa
      56
      4054

    3. Unisex-vessat

      Ahdistaa. Miksi kaikki pitää tasapäistää tasa-arvon nimissä? Tasa-arvo on sitä, että kunnioitetaan sukupuolien erilaisu
      Tunteet
      117
      3247

    4. Sosiaalidemokratia romahtanut kautta maailman

      nuoret eivät enää kannata järjetöntä aatetta, joten demarien täytyy hakea kannattajia mamuista. Ruotsin sos.demit jo kie
      Maailman menoa
      169
      2557

    5. Miksi Seta ja Sofia Virta ei vaadi muslimeita kunnioittamaan priden-arvoja?

      Kuten tiedetään niin islam ei hyväksy sitä mitä pride edustaa. Seta-pomo Mikkonen nosti hirveän äläkän kun yksi tepsin
      Maailman menoa
      108
      2296

    6. Vastuun ottaminen omasta hyvinvoinnista

      Olen huomannut tuttavapiirissäni ihmisiä, joilla on mt-diagnooseja. Sen sijaan, että millekään asialle yritettäisiin teh
      Henkinen hyvinvointi ja mielenterveys
      206
      1865

    7. Sofia Virralle täydet 12 pistettä!

      Kun ei jäänyt mukaan vähemmistöjen sortamista epäsuorasti tukevaan joukkueeseen. Urheilijoiden pitäisi olla esikuvia.
      Maailman menoa
      316
      1143

    8. Kuvaile kaivattusi

      ulkonäkö. Asiattomatkin kommentit saa laittaa. -🏚️
      Ikävä
      67
      943

    9. Miksi Hotelli Kainuuta dissataan?

      Ihmetyttää tämä jatkuva yhden yrityksen arvosteleminen. Ikäänkuin mikään ei olisi hyvin. Kuitenkin yritys työllistää, ta
      Kuhmo
      19
      913

    10. Missä milloin

      Missä milloin nähdään?
      Ikävä
      65
      818
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt