Servus miteiander,
folgende Aufgabenstellung:
Ich habe zwei Tabellen A & B. In Tabelle A ist eine Liste der relevanten Medien mit den dazugehörigen Basic-URLs (z.B. "aberwitzig.com").In Tabelle B (welche Variabel ist, da ich aus verschiedenen Tabellen Werte für meine Liste in Tabelle A finden will) befinden sich eine Vielzahl von Links (z.B. "http://www.aberwitzig.com/flachwitze.htm") verschiedener Online-Portale zu einem für meine Arbeit relevantem Thema. Zusätzlich zu den Links sind noch eine Vielzahl von Informationen gesammelt, unter anderem die Anzahl der Views die diese Seite im Monat hat.
Um die Reichweiten aus Tabelle B in die Tabelle A zu bekommen, nehme ich die Basic-URL, kopiere sie in eine ungenutzte Zelle in Tabelle B und durchsuche dann die Spalte mit den Links nach diesem Wert.
Das klappt an und für sich ganz gut, nur gibt mir die Funktion in unregelmäßigen Abständen EINEN wiederkehrenden Wert als Reichweite in Tabelle A wieder. Dieser Wert ist immer die Reichweite des ersten Links in Tabelle B. Dabei ist es unerheblich ob in Tabelle B die gesuchte Basic-URL enthalten ist oder nicht.
Ich hoffe das ist soweit verständlich. Ich danke für eure Mühe.
Sub neu()
Application.Workbooks("A.xlsx").Activate
' Die Länge der Tabelle A wird ermittelt
With Worksheets("Tabelle1")
For peter = 2 To 500
If Cells(peter, 12).Value = "" Then
Exit For
End If
Next
End With
Susi = peter - 1
Application.Workbooks("B.xlsx").Activate
' Länge der Tabelle B wird ermittelt
With Worksheets("TEMPLATE")
For Ilka = 2 To 500
If Cells(Ilka, 1).Value = "" Then
Exit For
End If
Next
End With
Herbert = Ilka - 1
Application.Workbooks("A.xlsx").Activate
' In Tabelle A wird der Link des Mediums ausgelesen
With Worksheets("Tabelle1")
For Petra = 2 To Susi
' Der Link wird kopiert
Cells(Petra, 13).Copy
Application.Workbooks("B.xlsx").Activate
'Der kopierte Wert wird in einer unbenutzen Zelle eingefügt
Cells(1, 15).Select
ActiveSheet.Paste
'Jetzt soll die Liste durchgearbeitet werden, ob der Basis-Link in einem der längeren Links enthalten ist
With Workbooks("B.xlsx").Worksheets("TEMPLATE")
For Georg = 2 To Herbert
Cells(Georg, 12).Select
'Falls das der Fall ist dann soll fünf Spalten nach links gesprungen werden, weil dort die Reichweite eingetragen ist
If InStr(ActiveCell.Value, Cells(1, 15).Value) > 0 Then
ActiveCell.Offset(0, -5).Select
ActiveCell.Copy
Application.Workbooks("A.xlsx").Activate
Cells(Petra, 14).Select
ActiveSheet.Paste
Exit For
End If
Next
End With
Next
End With
End Sub
|