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

776

    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. Moikka rakas

      Oon miettinyt meidän välistä yhteyttä viime aikoina. En ihan osaa pukea sanoiksi, mitä kaikkea tunnen, mutta halusin vaa
      Ikävä
      65
      17263
    2. Mitä tapahtunut

      Poliiseja monta autoa+panssariauto Porista kpäähän päin tänään klo n.20 kuka hurjistunut ?
      Kankaanpää
      42
      5092
    3. HS: Kuka vielä uskaltaa mennä sairaalan ensiapuun?

      https://www.hs.fi/mielipide/art-2000011212025.html Tässä on hyvin ajankohtainen mielipidekirjoitus koskien Malmin sairaa
      Maailman menoa
      301
      2813
    4. Gallup: kaivattusi syntymävuosi

      Minä vuonna kaipaamasi henkilö on syntynyt?
      Ikävä
      155
      2159
    5. Lakea konkurssiin. Asukkaat menettävät asuntonsa

      Kuntarahoitus on tänään jättänyt konkurssihakemuksen lakean kaikista kiinteistö osakeyhtiöistä. Kassa on tyhjä, kaikki
      Seinäjoki
      33
      1873
    6. Missäpäin,,,

      Lapuaa tapettu ihminen viime yönä ? Hurjaa touhua nykymeno täällä...
      Lapua
      22
      1674
    7. Ökyrikas Kurkilahti mussuttaa veroistaan

      Pakeni aikoinaan veroja Portugaliin mutta joutui palaamaan takaisin kun Suomi teki verotussopimuksen Portugalin kanssa.
      Maailman menoa
      140
      1668
    8. Yhdysvalloissa työllisyys paranee, Suomessa työttömyys kasvaa, missä vika?

      Miten tämä on mahdollista että 177 000 uutta työllistä tuli USAssa yhdessä kuukaudessa, vaikka Trump on ruorissa? Orpon
      Maailman menoa
      409
      1597
    9. mahdollista, että olet ollut iltavuorossa

      Ja kotiin päästyäsi tulit palstalle etsimään merkkiä minusta, jos kaipaat yhtään minua niin kuin minä sinua Ei mennyt k
      Ikävä
      11
      1447
    10. Jos tämän vaan sulkee ja avaa 5 vuoden päästä

      Täällä on luultavasti edelleen näitä ihan samoja juttuja. On kuin kauniit ja rohkeat samat jutut junnaa. Heips. 👋🏻 E
      Ikävä
      13
      1359
    Aihe