Option Explicit
Sub Test()
Dim rngPNr As Excel.Range
Set rngPNr = Worksheets("Tourenplan").Range("B2")
With CreateObject("Scripting.Dictionary")
Do While rngPNr.Value <> ""
If Not .Exists(rngPNr.Text) Then
If rngPNr.Worksheet.Cells(rngPNr.Row, "G").Value <> "" Then
Call .Add(Item:=rngPNr, Key:=rngPNr.Text)
End If
End If
Set rngPNr = rngPNr.Offset(1)
Loop
Dim vntPNr As Variant
For Each vntPNr In .Items()
Debug.Print vntPNr.Text, "["; vntPNr.Address(0, 0); "]"
Next
End With
End Sub