AW: nachfolgende Daten in Tabelle auslesen und anzeigen
13.11.2019 18:34:52
Piet
Hallo Manfredo
nach meiner Ansicht sollte der Code so wie unten laufen. Dazu müssen die drei Variablen vor For Next richtig gesetzt sein! Dem Workbook.Open Teil habe ich heraus genommen, weil bei deiner Auswertung über - If objWB.FullName = cstrFile1 Then die Datei bereits geöffnet sein muss!!
mfh Piet
Sub Test()
Tex_Variable = "Such Text ..."
cstrTab = "Tabelle2"
cstrFile1 = "F:\Excel Forum CxP 2019\Test.zlsm"
For Each objWB In Application.Workbooks
On Error GoTo Fehler
If objWB.FullName = cstrFile1 Then
With objWB
Set objRange = .Sheets(cstrTab).Columns(3).Find(What:=Tex_Variable, LookAt:= _
xlPart, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False)
If Not objRange Is Nothing Then
Adr1 = objRange.Address
Do 'mehrere Texte mit ", " als langen String erfassen
Tex_Lizenz = Tex_Lizenz & objRange.Offset(0, 5) & ", "
Tex_Litkurz = Tex_Litkurz & objRange.Offset(0, 1) & ", "
Tex_FREI = ex_FREI & objRange.Offset(0, 0) & ", "
Set objRange = .Sheets(cstrTab).Columns(3).FindNext(objRange)
If objRange Is Nothing Then Exit Do
Loop Until Adr1 = objRange.Address
'überflüssige ", " am Textende abschneiden
Tex_Lizenz = Left(Tex_Lizenz, Len(Tex_Lizenz) - 2)
Tex_Litkurz = Left(Tex_Litkurz, Len(Tex_Litkurz) - 2)
Tex_FREI = Left(Tex_FREI, Len(Tex_FREI) - 2)
Else
MsgBox "Anwendung nicht gefunden!"
End If
End With
End If
Next objWB
Exit Sub
Fehler: MsgBox objWB.Name & " unerwarteter Fehler"
End Sub