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

511

    Vastaukset 3

    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ä.

    Luetuimmat keskustelut

    1. Haluatko että unohdan sinut kokonaan

      Siihen suuntaan ollaan menossa, nyt jo. Ja ehkä parempi näin, niin ei kulu energiaa hukkaan mahdottomuuteen. Ja vaikka j
      Ikävä
      76
      1049
    2. Millä nimellä

      kutsut kaivattuasi omassa mielessäsi?
      Ikävä
      42
      764
    3. Pisa-tulokset.....

      Tuoreen tutkimuksen mukaan suomalaisten osaaminen on edelleen OECD-maiden keskitasoa parempaa. Kantaväestön oppilaiden
      Maailman menoa
      218
      634
    4. Meinasi nainen mennä pasmat sekaisin

      Rupesin vapisemaan, kun huomasin sinut. Mutta sain sentään juuri ja juuri koottua itseni, etten ihan häpäissyt itseäni.
      Ikävä
      34
      472
    5. Tiedät että on

      Tunteita yhä ja edelleen. Ehkä molemmin puolin.
      Ikävä
      23
      458
    6. Uskaltaisitko ihana nuorempi nainen lähettää

      WhatsApp -viestiä, jos sulla on mun numero. Olisin ihan haltioitunut... Tykkään ja kaipaan ❤️❤️
      Ikävä
      70
      415
    7. Ihan pikku vinkki

      Kannattaa tallentaa kaikki mitä sen naisen kanssa puhuu ettei tule hankaluuksia myöhemmin
      Ikävä
      52
      399
    8. Jos ajattelit että

      Annan anteeksi niin en anna.
      Ikävä
      18
      393
    9. Sinulle viestiä

      Me sitten oikeasti tutustutaan ensin!!
      Ikävä
      32
      385
    10. Haapaveden upea kurvikuningatar

      No nyt on kyllä mahtava uutinen että Haapaveden rohkea ja toimelias nainen ja yrittäjä on päässyt finaaliin kurvikuninga
      Haapavesi
      43
      384
    Aihe