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. YLE Äänekosken kaupunginjohtaja saa ankaraa arvostelua

      Kaupungin johtaja saa ankaraa kritiikkiä äkkiväärästä henkilöstöjohtamisestaan. Uusin häirintäilmoitus päivätty 15 kesä
      Äänekoski
      101
      2180

    2. Euroopan lämpöennätys, 48,8, astetta, on mitattu Italian Sisiliassa

      Joko hitaampikin ymmärtää. Se on aivan liikaa. Ilmastonmuutos on totta Euroopassakin.
      Maailman menoa
      302
      1980

    3. Useita puukotettu Tampereella

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

    4. 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
      344
      1781

    5. Martina lähdössä Ibizalle

      Eikä Eskokaan tiennyt matkasta. Nyt ollaan jännän äärellä.
      Kotimaiset julkkisjuorut
      209
      1637

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

      Suru vai suuri helpotus...
      Puolanka
      34
      1415

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

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

    8. 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ä
      94
      1143

    9. Se nainen näyttää hyvältä vaikka painaisi 150kg

      parempi vaan jos on vähän muhkeammassa kunnossa 🤤
      Ikävä
      70
      1130

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

      Minua nimittäin. Samoin hei! Olet mun vastakappaleeni.
      Ikävä
      51
      1077
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt