Option
Explicit
Sub
Main()
Dim
v
As
Variant
Dim
rngZeileMitEMails
As
Excel.Range
Set
rngZeileMitEMails = Range(
"A1:S1"
)
v = Application.Index(rngZeileMitEMails, 0, flngArray(Range(
"A2:S2"
)))
v = Application.Transpose(v)
v = Application.Transpose(v)
v = Join(v,
";"
)
Do
v = Replace(v,
";;"
,
";"
)
Loop
While
InStr(1, v,
";;"
) > 0
If
Left(v, 1) =
";"
Then
v = Mid(v, 2)
MsgBox v
End
Sub
Function
flngArray(
ByRef
rngZeileMitXen
As
Excel.Range)
As
Variant
Dim
col
As
Object
Dim
item
As
Variant
Set
col = CreateObject(
"System.Collections.ArrayList"
)
For
Each
item
In
rngZeileMitXen
If
Not
item =
"x"
Then
col.Add item.Column
End
If
Next
flngArray = col.ToArray
End
Function