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ä?
Moni haku kaava vba
3
495
Vastaukset
- 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 Functionkunde 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 Functionkorvaa 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
Kelekkakisat
Mikä vakava onnettomuus sattunut kisoissa. On peruttu koko kisat. Pelastuskopteri näytti käyvän paikalla.157302- 233944
- 983634
- 923109
Virkamiehille tarvitaan tuntuvat palkankorotukset
Naistenpäivänä on syytä muistuttaa, että virkamiehen euro on vain 80 senttiä. Palkat tulee saattaa samalle tasolle yksi133084- 553029
- 332727
- 462514
Pitäis vaan lopettaa
Sinun kanssa yhteydenpito. Alkaa vaan haluamaan enemmän ja tuskin lopulta mikään kohtaisi. Ja ikävä vaan kasvaa ja lähei132210Ikävä uutinen uudesta Unelmia Italiassa -kaudesta
Unelmia Italiassa -sarja on ollut supersuosittu ja uutta kautta on odotettu. Nyt on tullut se aika, että TV-katsojat pää82005