|
Moin Thomas,
eine mögliche Variante anhand folgender Umstände:
Vorliegende Liste:
Ausführlicher, langgezogener, teils hartcodierter Code zum besseren Nachvollziehen:
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
Schleife + neutral Umformulieren + Fehlerbehandlung + " nur die ersten 11 Personen" muss noch gemacht werden, aber ist, denke ich, eine kurzer gangbarer Weg.
|