Etsijasiirrä...

H_J_H

Olisi tälläinen makro mikä hakee välilehdeltä 1 sarakkeesta i sanaa "vika" ja sen löydettyä siirtää tarvittavien solujen tiedot välilehdelle "viat". Mutta miten saan yhdistettyä tähän makroon että se hakisi "vika" sanaa välilehdiltä 1 ja 2 sarakkeesta i ja välilehdiltä 3,4,5 sarakkeesta E ja sen jälkeen siirtäisi kaikilta välilehdiltä esimerkiksi sarakkeiden A,B ja C tiedot "viat" välilehdelle?

Tarvitaanko tähän kaksi eri hakufunktiota vai selviääkö mitenkään yhdellä??

Function EtsiJaSiirrä2(Hakuehto As Variant) As Range

Sheets("viat").Select
Rows("2:65536").Select
Selection.Delete
Range("A2").Select

Dim solu As Range
Dim EkaOsoite As String
Worksheets("välilehti1").Activate
With Range("I:I")
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
Dim solu As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä2("vika")
For Each solu In Löydetty
Union(solu.Offset(0, -8), solu.Offset(0, -6), solu.Offset(0, -3), solu.Offset(0, -2), solu.Offset(0, 0)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
Next
Exit Sub
virhe:
MsgBox "Ei vika tapauksia!", vbInformation
End Sub

2

309

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      Function EtsiJaSiirrä2(Hakuehto As Variant, Taulukko As String, Alue As String) As Range
      Dim solu As Range
      Dim EkaOsoite As String
      Worksheets(Taulukko).Activate
      With Range(Alue)
      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
      Dim solu As Range
      Dim laskuri As Integer
      Sheets("viat").Rows("2:65536").Delete
      Range("A2").Select
      Set Löydetty = EtsiJaSiirrä2("vika", "välilehti1", "I:I")
      If Not Löydetty Is Nothing Then
      For Each solu In Löydetty
      Union(solu.Offset(0, -8), solu.Offset(0, -7), solu.Offset(0, -6)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
      laskuri = laskuri 1
      Next
      End If

      Set Löydetty = EtsiJaSiirrä2("vika", "välilehti2", "I:I")
      If Not Löydetty Is Nothing Then
      For Each solu In Löydetty
      Union(solu.Offset(0, -8), solu.Offset(0, -7), solu.Offset(0, -6)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
      laskuri = laskuri 1
      Next
      End If

      Set Löydetty = EtsiJaSiirrä2("vika", "välilehti3", "E:E")
      If Not Löydetty Is Nothing Then
      For Each solu In Löydetty
      Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
      laskuri = laskuri 1
      Next
      End If

      Set Löydetty = EtsiJaSiirrä2("vika", "välilehti4", "E:E")
      If Not Löydetty Is Nothing Then
      For Each solu In Löydetty
      Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
      laskuri = laskuri 1
      Next
      End If

      Set Löydetty = EtsiJaSiirrä2("vika", "välilehti5", "E:E")
      If Not Löydetty Is Nothing Then
      For Each solu In Löydetty
      Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
      laskuri = laskuri 1
      Next
      End If
      If laskuri = 0 Then
      MsgBox "Ei vika tapauksia!", vbInformation
      Else
      MsgBox "vika tapauksia löytyi " & laskuri & " kpl!", vbInformation
      End If
      End Sub

      • H_J_H

        Pelaa loistavasti!! Kiitos Kundelle

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Useita puukotettu Tampereella

      Mikäs homma tämä nyt taas on? "Useaa henkilöä on puukotettu Tampereen keskustassa kauppakeskus Ratinan lähistöllä." ht
      Tampere
      179
      3470

    2. Asiakas iski kaupassa varastelua tehneen kanveesiin.

      https://www.iltalehti.fi/kotimaa/a/33a85463-e4d5-45ed-8014-db51fe8079ec Oikein. Näin sitä pitää. Kyllä kaupoissa valtava
      Maailman menoa
      374
      2186

    3. Kuka rääkkää eläimiä Puolangalla?

      Poliisi ampui toistakymmentä nälkiintynyttä eläintä Puolangalla Tilalta oli ollut karkuteillä lähes viisikymmentä nälkii
      Puolanka
      55
      2157

    4. Leipivaaran päällä on kuoleman hiljaista.

      Suru vai suuri helpotus...
      Puolanka
      42
      2028

    5. Meneeköhän sulla

      oikeasti pinnan alla yhtä huonosti kuin mulla? Tai yhtä huonosti mutta jollain eri tyylillä? Ei olisi pitänyt jättää sua
      Ikävä
      32
      1481

    6. Jos ei tiedä mitä toisesta haluaa

      Älä missään nimessä anna mitään merkkejä kiinnostuksesta. Ole haluamatta mitään. Täytyy ajatella toistakin. Ei kukaan em
      Ikävä
      93
      1251

    7. Määpä tiijän että rakastat

      Minua nimittäin. Samoin hei! Olet mun vastakappaleeni.
      Ikävä
      54
      1203

    8. Muutama kysymys ja huomio hindulaisesta kulttuurista.

      Vedakirjoituksia pidetään historiallisina teksteinä, ei siis "julistuksena" kuten esimerkiksi Raamattua, vaan kuten koul
      Hindulaisuus
      416
      1142

    9. Jumala puhui minulle

      Hän kertoi sinusta asioita, joiden takia jaksan, uskon ja luotan. Hän kuvaili sinua minulle ja pakahduin onnesta kuulles
      Ikävä
      117
      1039

    10. Koska näit kaivattusi viimeksi

      Milloin tapasit rakkaasi? Ja etenikö suhde yhtään?
      Ikävä
      57
      958
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt