Moni haku kaava vba

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

Lue lisää

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