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

348

Ää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. Pystyisitkö pitämään

      Näppejä erossa jos tulisi siihen tilaisuus
      Ikävä
      46
      4309

    2. Yritystuet 10 mrd. vuodessa, eli yrittäjäriski valtiolla kuten kommunismissa

      Pelkästään Viking Linen viinanhakuristeilyitä sponsoroidaan 20 miljoonalla eurolla vuosittain. Dieselin verotukikin on
      Yrittäjyys
      13
      4132

    3. Luotathan siihen tunteeseen, joka välillämme on?

      Uskothan myös, että se kestää tämän? Kaipaan sinua valtavasti. Vielä tehdään yhdessä tästä jotain ihmeellistä ja kaunist
      Ikävä
      44
      3388

    4. Riikka on siis suomalaisille velkaa 84 mrd

      Jos kauhukabinetti istuu vaalikauden loppuun. Keskimäärin yli 20 miljardia uutta velkaa rikkaiden veronalennuksiin jokai
      Maailman menoa
      88
      3330

    5. En saa sua mielestäni vaikka tekisin mitä

      Mikä tähän auttaa.. ei mikään. Edes aika. Kaivan sut kohta vaikka kivenkolosta että saan kysyä haluatko sinäkin💛
      Ikävä
      14
      3167

    6. Sanna on suomalaisille siis velkaa 24 mrd euroa

      Muistanette vielä kuinka Italian remonttirahoja perusteltiin sillä, että italialaiset ostaa suomalaisilta paidatkin pääl
      Maailman menoa
      164
      2860

    7. Onnettomuus

      Hukkajärventiellä kolaroi lavetti ja henkilöauto. Uutista ei missään! Hys hys ollaanko hiljaa tästäkin?
      Kuhmo
      4
      2460

    8. Tuntuuko ettet tiedä

      Enää miten toimia mun suhteen. Kun en taida tietää itsekään
      Ikävä
      25
      2449

    9. Sture Fjäder haluaa tuensaajien nimet julki

      Kokoomuspoliitikko haluaa yli 800 euroa kuukaudessa tukia saavien nimet julki. Ehkä olisi syytä julkaista myös kuvat? h
      Maailman menoa
      60
      2313

    10. Kirjotan ikävää ulos

      Haluaisin kuulla mitä ajattelet minusta. ihan mitä vaan mitä mietit. Voisit kertoa minulle, tai sitten kirjoittaisit run
      Ikävä
      14
      1888
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt