Moni haku kaava vba

jaakkoko

Minulla työkirjassa Taul2 data alue, A:I830. 1 rivillä on varaosakaapin NIMI.

Tein nauhoittamalla etsintä kaavan, laitin kyselyn msgoxiin, millä annetaan haku arvo, Nyt homma toimii jos on vain yksi saman niminen, mutta tiedän muutaman saman numeroisen varaosan sijaitsevan 3:SSA erikaapissa. Kuinka saisin tehtyä ns. listauksen tähän msgboxiin. Nyt se kertoo minulle vain tuon A1 olevan arvon. Haluaisin sen kuitenkin ilmoittavan, ESIM A1, C1 ja D4 kaapeissa on kyseisiä teriä?

3

479

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • näinyhtäkkiä

      käydä siirtämässä ne muutamat varaosat kaappiin jossa "kaimat" ovat?

      • taulukon moduuliin...
        nyt hakee solun K1 arvoja sarakkeista A-I ja ilmoittaa solun osoitteen, jos haluat että palauttaa sen ekan rivin kaapin nimen niin muutellaan sitten

        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim tulos As String
        On Error Resume Next
        If Not Intersect(Target, Range("K1")) Is Nothing Then
        tulos = EtsiJaNäytä(Range("K1"), Range("A:I")).Address
        If tulos = "" Then
        MsgBox "ei löytynyt!"
        Else
        MsgBox tulos
        End If
        End If
        End Sub

        ja moduuliin...

        Function EtsiJaNäytä(Hakuehto As Variant, HakuAlue As Range) As Range
        Dim solu As Range
        Dim EkaOsoite As String

        With HakuAlue
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaNäytä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaNäytä = Union(EtsiJaNäytä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function


      • kunde kirjoitti:

        taulukon moduuliin...
        nyt hakee solun K1 arvoja sarakkeista A-I ja ilmoittaa solun osoitteen, jos haluat että palauttaa sen ekan rivin kaapin nimen niin muutellaan sitten

        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim tulos As String
        On Error Resume Next
        If Not Intersect(Target, Range("K1")) Is Nothing Then
        tulos = EtsiJaNäytä(Range("K1"), Range("A:I")).Address
        If tulos = "" Then
        MsgBox "ei löytynyt!"
        Else
        MsgBox tulos
        End If
        End If
        End Sub

        ja moduuliin...

        Function EtsiJaNäytä(Hakuehto As Variant, HakuAlue As Range) As Range
        Dim solu As Range
        Dim EkaOsoite As String

        With HakuAlue
        Set solu = .Find( _
        What:=Hakuehto, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
        If Not solu Is Nothing Then
        Set EtsiJaNäytä = solu
        EkaOsoite = solu.Address
        Do
        Set EtsiJaNäytä = Union(EtsiJaNäytä, solu)
        Set solu = .FindNext(solu)
        Loop While Not solu Is Nothing And solu.Address EkaOsoite
        End If
        End With
        End Function

        korvaa aikaisempi koodi tällä ja näyttää kaappien nimet 1. riviltä
        taulukon moduuliin...

        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim tulos As String
        Dim a As Variant
        Dim Kaapit As String
        On Error Resume Next
        If Not Intersect(Target, Range("K1")) Is Nothing Then
        tulos = EtsiJaNäytä(Range("K1"), Range("A:I")).Address
        If tulos = "" Then
        MsgBox "ei löytynyt!"
        Else
        a = Split(tulos, ",")
        For i = 0 To UBound(a)
        Kaapit = Kaapit & Range(Mid(a(i), 2, 1) & 1) & vbNewLine
        Next
        MsgBox Kaapit
        End If
        End If
        End Sub


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Kotihoito suomussalmella

      Mitämieltä ootte suomussalmen kotihoidosta?
      Suomussalmi
      40
      5585
    2. Maataloustuet pois

      Jokainen maksakoon harrastuksensa itse. Eihän golfin peluutakaan maksa yhteiskunta.
      Maailman menoa
      223
      4541
    3. Joko alkaa menemään tajuntaan tämä yliluonnollinen yhteys?

      Varmaan pikkuhiljaa. Muista olla kiltisti ❤️
      Ikävä
      36
      4484
    4. Australia, Britannia ja Kanada tunnustivat Palestiinan

      Aikooko Petteri Lapanen pysytellä persujen ja uskovaisten panttivankina ja jättää Suomen historian väärälle puolelle?
      Maailman menoa
      72
      4295
    5. Kohtalokas laukaus

      IL 20.9.25 "Ihminen kuoli baarin edustalla Kajaanissa Poliisi ei epäile tapauksessa rikosta." "Kajaanin keskustassa on k
      Kajaani
      26
      4262
    6. Työeläkkeen saamiseksi olisi tehtävä töitä

      Meillä on Suomessa iso joukko ihmisiä, joilla olisi vielä työkykyä jäljellä, mutta joilta puuttuu arjesta mielekäs tekem
      Maailman menoa
      160
      3765
    7. Mitä juuri sinulle kuuluu?

      Tänään? Rehellisesti.
      Ikävä
      92
      3112
    8. Joulukinkku NYT

      Sian kankuista tulee vielä pula. Nyt on oikea aika hankkia joulukinkku.
      Maailman menoa
      20
      3035
    9. Muistattekos kun Sannan aikana suomalaisten varallisuuteen lisättiin viidennes

      Köyhät voittivat eniten mutta rikkaimmat kuitenkin köyhtyi!
      Maailman menoa
      27
      3021
    10. Linux Mint asennus kaatuu heti alkuun

      Tulee kernel panic BIOS-tekstin jälkeen. Yritän ensimmäistä kertaa asentaa Linux Minttiä vanhalle Windows 10 -läppärill
      Apua aloittelijalle
      10
      2140
    Aihe