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

320

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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ä.

    Luetuimmat keskustelut

    1. Janni Tikkanen ohjattiin miesten pukuhuoneeseen

      Vai olisko sittenkin Janne Tikkanen? Jos siellä jalkojen välissä on miesten killukkeet, mieshän tämä Janni on. Ja kuuluu
      Kajaani
      86
      2247
    2. Keskisarja loisti A-studiossa, vauhkoontunut Sofia Virta munasi itsensä

      Keskisarja taas puhui 100% faktaa maahanmuuttoon liittyen. Kokoomuksen Kaumalta tuli pari hyvää puheenvuoroa, joskin muu
      Maailman menoa
      433
      2140
    3. Rakastan ja ikävöin sinua

      Ei helpota tämä ikävä millään. Pelkäsin että tämä ajanjakso tulee olemaan juuri näin vaikea. Siksi halusin ennen tätä pä
      Ikävä
      77
      1442
    4. Tiedän ettet tehnyt tahallasi pahaa

      Asiat tapahtuivat, ristiriidat ovat meitä vahvempia. Olemmeko me niin vahvoja, että selviämme tästäkin vielä? Aika paljo
      Ikävä
      110
      1420
    5. Vihjeketju naisille

      Kirjoita tähän vihjeesi kaivatullesi.
      Ikävä
      67
      1313
    6. Venäläistä sukellusvenettä jahdataan Norjassa Sukellusvenettä on etsitty sunnuntaista lähtien.

      Venäläistä sukellusvenettä jahdataan Norjassa Sukellusvenettä on etsitty sunnuntaista lähtien. Norjassa on käynnissä ve
      NATO
      107
      1065
    7. Haluatko tietää totuuden?

      Olen kyllästynyt sinuun. Et herätä enää mielenkiintoa. Samat jutut x 100. Kuten narskuilla aina. Samalla tunnen myötätun
      Ikävä
      81
      1032
    8. Teräväkielinen Virta jauhotti totaalisesti sössöttävän Keskisarjan

      Harvoin on noin suvereenia jauhotusta A-studiossa nähty. Ja minä äänestän demareita, joita ei oltu paikalle edes kutsut
      Maailman menoa
      257
      1023
    9. Sofia Virta pyyhkii pöytää Keskisarjalla A studiossa

      Hurjaa on meno. Keskisarja ihan kanveesissa.
      Perussuomalaiset
      269
      1017
    10. Sä olet epävakaa

      tai ainakin yrität onnistuneesti vaikuttaa siltä. Ei sun kanssa uskalla ruveta yhtään mihinkään, menis hommat ojasta all
      Ikävä
      15
      952
    Aihe