Hei!
Onko mahdollista tehdä semmoinen makro joka osaa noutaa Sheet2 A1, A2, A3 jne tiedon ja etsii vastaavat Sheet1:ltä ja jos vastaavuus löytyy, niin värjää ne suoraan punaiseksi.
Minulla on sheet2 noin 300 solua joiden vastaavuudet pitäisi etsiä Sheet1, ja jotta huomaisin solut paremmin, haluaisin ne värjäytyvän.
Kiitoksia etukäteen!
Vastaavuuden löytäminen Sheet1 ja Sheet2 välillä
etsiminen on taidetta.
8
813
Vastaukset
- ...
Ehdollisella muotoilulla saattaisi onnistua. Toisella arkilla nimetään ensin vertailtava alue.
Muotoiluehdoksi kaavan arvo =Laske.Jos(Alue;A1)>0- toimi..........
mut ehdollinen muotoilussa joudun aina vaihtamaan arvon. Tarkoituksena olisi et makro käy tietyn listan läpi ja etsii toisesta alueesta vastaavuudet.
- hyvin toimii
toimi.......... kirjoitti:
mut ehdollinen muotoilussa joudun aina vaihtamaan arvon. Tarkoituksena olisi et makro käy tietyn listan läpi ja etsii toisesta alueesta vastaavuudet.
nimeät sheet1 alueen vaikka ekaAlue ja valitset sheet2:n alueen jolle haluat muotoilun,laitat ehdolliseen muotoiluun
formula is =COUNTIF(ekaAlue;A2) ja valitse haluamasi värin
vähän oli ylimalkainen kyssäri tiedoilta, mutta tolla alkuun
moduuliin...
nimeä taulukko2 verrattavat solut ="Alue" ja muokkaa taulukoiden nimet sopiviksi
Option Explicit
Dim EiTupla As New Collection
Sub Värjää()
Dim Tiedot As Variant
Dim Alue As Range
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("Sheet2").Activate
PoistaTuplat
Worksheets("Sheet1").Cells.Interior.ColorIndex = xlNone
For i = 1 To EiTupla.Count
Set Alue = EtsiJaSiirrä(EiTupla(i), Worksheets("Sheet1").Cells)
Alue.Interior.ColorIndex = 3
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub PoistaTuplat()
Dim solu As Range
Dim Vika As Double
On Error GoTo virhe
For Each solu In Range("Alue")
If Not IsEmpty(solu) Then
EiTupla.Add solu.Value, CStr(solu.Value)
End If
Next solu
Exit Sub
virhe:
Resume Next
End Sub
Function EtsiJaSiirrä(Haettava As Variant, _
Hakualue As Range) As Range
Dim solu As Range
Dim ekaosoite As String
With Hakualue
Set solu = .Find( _
What:=Haettava, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
ekaosoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address ekaosoite
End If
End With
End Function- vaatii!
Hei!
Makro toimii, kiitos.
Pientä ongelmaa pukkaa silloin kun haluan etsiä vastaavuudet uudestaan. Nimittäin olen tehnyt niin, että poistan värjäykset kokonaan Sheet1 taulukosta. Sen jälkeen muokkaan Sheet2, sitä taulukkoa mistä tiedot haetaan. Esim. Poistan sieltä kaikki paitsi yhden solun. Kun ajan värjäys_makron uudestaan, niin värjää makro samat solut kuin aikaisemmalla kerralla. Ihan ku makro hakisi tiedot jostain muistista, eikä siltä Sheet2 alueelta.
Tietäisitkö missä mahtaa olla vika? vaatii! kirjoitti:
Hei!
Makro toimii, kiitos.
Pientä ongelmaa pukkaa silloin kun haluan etsiä vastaavuudet uudestaan. Nimittäin olen tehnyt niin, että poistan värjäykset kokonaan Sheet1 taulukosta. Sen jälkeen muokkaan Sheet2, sitä taulukkoa mistä tiedot haetaan. Esim. Poistan sieltä kaikki paitsi yhden solun. Kun ajan värjäys_makron uudestaan, niin värjää makro samat solut kuin aikaisemmalla kerralla. Ihan ku makro hakisi tiedot jostain muistista, eikä siltä Sheet2 alueelta.
Tietäisitkö missä mahtaa olla vika?"Esim. Poistan sieltä kaikki paitsi yhden solun. Kun ajan värjäys_makron uudestaan, niin värjää makro samat solut kuin aikaisemmalla kerralla. Ihan ku makro hakisi tiedot jostain muistista, eikä siltä Sheet2 alueelta."
nimeä taulukko2 verrattavat solut ="Alue"
et ole nimennyt haettavia soluja uudelleen.
"poistan värjäykset kokonaan Sheet1 taulukosta"
Makrohan poistaa värjäykset automaattisesti Sheet1:stä.Joten ei tartte tehdä...
eli...
Nimeä vain ne solut mitä vertaat ="Alue" ja toimii just niinkuin pitääkin...- .....
kunde kirjoitti:
"Esim. Poistan sieltä kaikki paitsi yhden solun. Kun ajan värjäys_makron uudestaan, niin värjää makro samat solut kuin aikaisemmalla kerralla. Ihan ku makro hakisi tiedot jostain muistista, eikä siltä Sheet2 alueelta."
nimeä taulukko2 verrattavat solut ="Alue"
et ole nimennyt haettavia soluja uudelleen.
"poistan värjäykset kokonaan Sheet1 taulukosta"
Makrohan poistaa värjäykset automaattisesti Sheet1:stä.Joten ei tartte tehdä...
eli...
Nimeä vain ne solut mitä vertaat ="Alue" ja toimii just niinkuin pitääkin...Opettelen vasta VBA:ta, joten kiitoksia kärsivällisyydestä.
Olen nimennyt alueen näin:
For Each solu In Range("A2:A6000")
Tieto haetaan sheet2 ja alueesta A2:A6000.
Onko tämä oikein? ..... kirjoitti:
Opettelen vasta VBA:ta, joten kiitoksia kärsivällisyydestä.
Olen nimennyt alueen näin:
For Each solu In Range("A2:A6000")
Tieto haetaan sheet2 ja alueesta A2:A6000.
Onko tämä oikein?originelli oli näin, ja siinä on toi "Alue", jonka määrittelet valikosta lisää/nimi/määritä Insert/Name/Define ja siinä valitset haluamasi solut ja annat alueelle nimeksi Alue. Näin sen ajattelin...
Ok voit muuttaa koodia siten, että korvaat
For Each solu In Range("Alue") tällä
For Each solu In Range("A2:A6000") ja käyt sitten koodissa muuttamassa aluetta.
Tietenkin voit tehdä niin, että valinta on alueena, niin ei tartte kuin valita testattavat solut ja suorittaa koodi
esim.
Sub PoistaTuplat()
Dim solu As Range
Dim Vika As Double
On Error GoTo virhe
For Each solu In Selection
If Not IsEmpty(solu) Then
EiTupla.Add solu.Value, CStr(solu.Value)
End If
Next solu
Exit Sub
virhe:
Resume Next
End Sub
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Eutanasia?
Kertokaas omia mielipiteitä eutanasiaan liittyen. Onko mielestäsi oikein vai väärin ja miksi?412326Eutanasia - miksi eläimelle sallitaan armokuolema, mutta ihmiselle ei?
Olen pitkään ihmetellyt yhtä asiaa Suomessa. Kun koira kärsii parantumattomasta sairaudesta ja kovista kivuista, eläinlä211113Riikka Purran kaudella nousi bensan hinta yli 2 euron
Muistatteko kuinka edellisen vasemmistohallituksen aikana, ns. Marinin aikakaudella, bensiiniä sai 1,3 euron litrahinnal1735062Veli Sofia teki urosmehiläisen työn
Paljastaessaan kuinka TPS:ssä ei joukkuehenki toimi sooloilijoiden vuoksi, jonka takia koko seura ei pärjää kilpailussa263659Mitäs nyt sijoittajat?
Pörssit laskevat maailmalla Iranin sodan takia ja muutenkin ovat olleet Trumpin vallan alla epävarmat. Ainoa, mikä on no1863495Hjallis Harkimon, 72, Jasmine-rakas, 37, paljastaa suhteen alusta: "Vähän..."
Liikemies, kansanedustaja Hjallis Harkimo ja tuottaja-juontaja Jasmine Pajari ovat pariskunta. He asuvat yhdessä Sipooss423007Unisex-vessat
Ahdistaa. Miksi kaikki pitää tasapäistää tasa-arvon nimissä? Tasa-arvo on sitä, että kunnioitetaan sukupuolien erilaisu1082739Sosiaalidemokratia romahtanut kautta maailman
nuoret eivät enää kannata järjetöntä aatetta, joten demarien täytyy hakea kannattajia mamuista. Ruotsin sos.demit jo kie342106Jäit kiinni siitä
että katselet minua. Käänsin pääni, minäkin etsin sinua, ja meidän katseemme kohtasivat. Eikä se haittaa - molemmat ky121994Jutta Larm, 52, haluaa kumota tämän piintyneen ikämyytin
Oletko samaa mieltä? Jutta Larm on 52-vuotias ja tehnyt pitkän uran yrittäjänä. Hän haluaa kumota tämän piintyneen ikämy191925