Vastaavuuden löytäminen Sheet1 ja Sheet2 välillä

etsiminen on taidetta.

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!

8

752

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • ...

      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

    1. JOKO OLETTE KUULLET, MITÄ KIURUVEDELLÄ ON SATTUNUT!

      Oletteko jo kuulleet, mitä Kiuruvedellä on sattunut, voi hyvänen aika? Aivan viime tuntien aikana olisi sattunut, jos t
      Kiuruvesi
      40
      12873
    2. V*ttuu että mä haluan sua

      Jos jotain ihmistä voi kunnolla haluta, niin hän on se. Voi Luoja auta jo! Joku jeesus hjelppa mej!
      Ikävä
      91
      4461
    3. Nolointa ikinä miehelle

      On ghostata nainen jonka kanssa on ollut ystävä tai ollu orastavaa tapailua pidemmän aikaa. Osoittaa sellaista moukkamai
      Ikävä
      114
      4134
    4. Katsoitko mua yhtään

      Kun nähtiin 🥺.
      Ikävä
      51
      3688
    5. Eli jos toisen hiki haisee ns. omaan nenään siedettävältä

      Se kertoo hyvästä yhteensopivuudesta. Selvä! Olet mies minun. 🫵🥳
      Ikävä
      53
      3381
    6. Mikä sinua eniten

      Huolestuttaa tässä tilanteessa?
      Ikävä
      120
      3367
    7. Sattuma ja muutama väärinkäsitys

      vaikuttivat siihen millaiseksi tämä kaikki muodostui. Pienet aikanaan huomaamattomat käänteet. Seuraava näytös on jo tul
      Ikävä
      49
      2282
    8. Koska olet viimeksi nähnyt ikävän kohteesi?

      Ja mitä tarjoat hänelle kun koputtaa oveesi?
      Ikävä
      43
      2251
    9. Keskusta hajoaa Palojärvi lähtee

      Suomen Keskustan ryhmä hajoaa Kemijärvellä. Kalastaja Palojärvi sai tarpeekseen ja loikkasi Sitoutumattomat Aati Virkkul
      Kemijärvi
      31
      2054
    10. On sillä rääpyä

      Tuo ex kuntajohtaja Lea Tolonen kehtaakin tulla Ähtäriin. Ajoi laivan Karille. Kari Heikkilä oikaisi taloutta, sai laiva
      Ähtäri
      14
      1718
    Aihe