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

276

Ää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. Anna minulle anteeksi

      Anna minulle anteeksi. Minä pyydän.
      Ikävä
      158
      2639

    2. Kun viimeksi kohtasitte/näitte

      Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...
      Ikävä
      135
      1976

    3. Olet kyllä vaarallisen himokas

      Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.
      Ikävä
      108
      1846

    4. Mikä on hän on ammatiltaan?

      Vai tiedätkö mitä kaivattusi tekee työkseen?
      Ikävä
      73
      1500

    5. Mitä ajattelit silloin kun

      Löysit hänet?
      Ikävä
      80
      1466

    6. Anna vielä vähän vihreää valoa

      Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet
      Ikävä
      24
      1452

    7. Syksyinen aamuketju suden

      Hyvää huomenta ja kaunista syyspäivää. 🌞🍁🍂☕
      Ikävä
      227
      1100

    8. Uskotko että kohdataan vielä?

      Kysymys otsikossa, aloitukseen ei muuta lisättävää.
      Ikävä
      65
      969

    9. Miksi homous puhuttaa konservatiiveja vuodesta toiseen?

      Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv
      Luterilaisuus
      230
      942

    10. Oletko tutustunut muihin

      Samalla tavalla kuin häneen?
      Ikävä
      73
      920
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt