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
Etsijasiirrä...
2
320
Vastaukset
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
Keskisarja loisti A-studiossa, vauhkoontunut Sofia Virta munasi itsensä
Keskisarja taas puhui 100% faktaa maahanmuuttoon liittyen. Kokoomuksen Kaumalta tuli pari hyvää puheenvuoroa, joskin muu5522800Janni Tikkanen ohjattiin miesten pukuhuoneeseen
Vai olisko sittenkin Janne Tikkanen? Jos siellä jalkojen välissä on miesten killukkeet, mieshän tämä Janni on. Ja kuuluu892542Sä olet epävakaa
tai ainakin yrität onnistuneesti vaikuttaa siltä. Ei sun kanssa uskalla ruveta yhtään mihinkään, menis hommat ojasta all211611Rakastan 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ä771542Tiedän ettet tehnyt tahallasi pahaa
Asiat tapahtuivat, ristiriidat ovat meitä vahvempia. Olemmeko me niin vahvoja, että selviämme tästäkin vielä? Aika paljo1101480- 691394
Mieti miten paljon yritin
Löytää yhteyttä kanssasi uudelleen sen väärinymmärryksen jälkeen. Koen etten tullut puoleltasi hyvin kohdelluksi mies😔421385- 271298
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 kutsut3091276Haluatko tietää totuuden?
Olen kyllästynyt sinuun. Et herätä enää mielenkiintoa. Samat jutut x 100. Kuten narskuilla aina. Samalla tunnen myötätun901173