28.10.2020, 10:24
Guten Morgen zusammen,
ich habe ein vermutlich simples Problem, aber ich komme nicht weiter. Und zwar habe ich unten stehenden Code geschrieben, der mir Bezirke zu gewissen Postleitzahlen raussucht. Dies muss ich allerdings für 25 Stops machen (Spalten). Dabei liegen die Spalten immer im gleichen Abstand nebeneinander, sprich in diesem Text: 14 --> 21 (+7), 15 --> 22 (+7) und Spalte N sollte im nächsten Durchgang U sein (+7). Und dieser ganze Prozess dann insgesamt 25 mal. (für den einen Wert also 14,21,28,35,42,49 etc.). Könnte mir da jemand weiterhelfen? :)
Beste Grüsse
nionox
ich habe ein vermutlich simples Problem, aber ich komme nicht weiter. Und zwar habe ich unten stehenden Code geschrieben, der mir Bezirke zu gewissen Postleitzahlen raussucht. Dies muss ich allerdings für 25 Stops machen (Spalten). Dabei liegen die Spalten immer im gleichen Abstand nebeneinander, sprich in diesem Text: 14 --> 21 (+7), 15 --> 22 (+7) und Spalte N sollte im nächsten Durchgang U sein (+7). Und dieser ganze Prozess dann insgesamt 25 mal. (für den einen Wert also 14,21,28,35,42,49 etc.). Könnte mir da jemand weiterhelfen? :)
Beste Grüsse
nionox
Code:
Sub Bezirkszuweisung1()
Dim Berechnung As Worksheet, Ortschaftenverzeichnis As Worksheet
Dim Berechnunglastrow As Long, Ortschaftenverzeichnislastrow As Long, x As Long
Dim OrtschaftenverzeichnisRng As Range, suchtext As String, findrng As Range
Dim celladdress As String
Set Berechnung = ThisWorkbook.Worksheets("Berechnung")
Set Ortschaftenverzeichnis = ThisWorkbook.Worksheets("Ortschaftenverz.-Rép. Localités")
Berechnunglastrow = Berechnung.Range("B" & Rows.Count).End(xlUp).Row
Ortschaftenverzeichnislastrow = Ortschaftenverzeichnis.Range("H" & Rows.Count).End(xlUp).Row
Set OrtschaftenverzeichnisRng = Ortschaftenverzeichnis.Range("H2:H" & Ortschaftenverzeichnislastrow)
For x = 2 To Berechnunglastrow
If Cells(x, 14) <> "" Then
suchtext = Worksheets("Berechnung").Range("N" & x).Value
Set findrng = OrtschaftenverzeichnisRng.Find(What:=suchtext, LookIn:=xlValues)
If findrng Is Nothing Then
Worksheets("Berechnung").Cells(x, 15) = "N/A"
Else
Worksheets("Berechnung").Cells(x, 15) = Worksheets("Ortschaftenverz.-Rép. Localités").Cells(findrng.Row, 12)
End If
End If
If Cells(x, 14) = "" Then
Worksheets("Berechnung").Cells(x, 15) = "N/A"
End If
Next x
End Sub