Sub
sendEmails()
Dim
rngWerte
As
Range
Dim
rngEmail
As
Range
Dim
iEmail
As
Integer
Dim
strEmail
As
String
Dim
rng
As
Range
Set
rngWerte = Range(Range(
"D1"
), Range(
"D1"
).
End
(xlDown))
Set
rngEmail = Range(Range(
"B1"
), Range(
"B1"
).
End
(xlDown))
For
Each
rng
In
rngWerte.Cells
iEmail = NumbersInValue(rng.Value)
strEmail = rngEmail.Cells(iEmail, 1).Value
Debug.Print strEmail
Next
End
Sub
Function
NumbersInValue(text
As
String
)
As
Integer
Dim
iPos
As
Integer
Dim
strOut
As
String
For
iPos = 1
To
Len(text)
If
IsNumeric(Mid(text, iPos, 1))
Then
strOut = strOut & Mid(text, iPos, 1)
End
If
Next
NumbersInValue = strOut
End
Function