Auswahl richtige Schleife

[Cirda]

Guten Morgen ihr alle,

ich traue mich mittlerweile etwas mehr an VBA Programmierung ran. ich habe mir verschiedenste Codefetzen zusammengebaut, scheitere nun aber bei der Auswahl einer passenden Schleife um eine Bedingung zu erfüllen.

Das ganze Prozedere soll folgendes durchführen.Auf einer Eingabemaske wählt man Daten aus. Diese bestehen aus 4 verschiedenen Blöcken, die zuerst in verschieden Spalten aufgelöst und von führenden Freiziechen befreit werden. Nachdem dann die Variablen eingelesen wurden, wird erst das Formular gelöscht und dann geht es in die Schleife.

Diese soll anhand der Variable PN in einer bestimmten Liste (LZ) den passenden Eintrag finden, diese Zeile kopieren und in eine der vorhandenen Listen, je nach Variable LZneu einfügen. Danach kann in dem alten Tabellenblatt die Zeile gelöscht werden.

Bisher ist es so, das alles so funktioniert wie ich mir das vorstelle. Allerdings nur bei Einträgen diesich in die Zeile 3 eintragen.

Ich denke ich habe etwas falsch gemacht.

Der bisherige Code ist:

Sub Mitarbeiterwechsel()

Dim Anz As Variant
Dim LZ As String
Dim LZneu As Variant
Dim Name As String
Dim Vorname As String
Dim PN As String
Dim zeile As String

'Gesamtspalte auflösen
Anz = Range("j5").Value
Range("j5").Select
    Selection.TextToColumns Destination:=Range("m5"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
       
'Leerzeichen löschen
Range("m5:p5").Select
Dim Zelle As Range
For Each Zelle In Selection
 Zelle.Value = Application.Trim(Zelle.Value)
Next Zelle

'Variablen einlesen
LZ = Range("p5").Value
PN = Range("o5").Value
Name = Range("m5").Value
Vorname = Range("n5").Value
LZneu = Range("j7").Value


'Formular löschen
Range("j5").Select
Selection.ClearContents
Range("j7").Select
Selection.ClearContents
Range("j5").Value = "Bitte auswählen"
Range("M5:S5").Select
Selection.ClearContents

'Mitarbeiter identifizieren
Sheets(LZ).Select
zeile = 3
Do While Range("A" & zeile).Value = PN
    Rows(zeile).Select
    Selection.Copy
    zeile = zeile + 1
Loop

'Daten verschieben
Sheets(LZneu).Select
Rows(3).Select
Selection.Insert Shift:=xlDown
       
   
'sortieren nach Namen
ActiveWorkbook.Worksheets("Referenz").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Referenz").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A461"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
With ActiveWorkbook.Worksheets("Referenz").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
    Sheets(LZ).Select
    ActiveWorkbook.Worksheets(LZ).AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(LZ).AutoFilter.Sort.SortFields.Add _
        Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets(LZ).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Mitarbeiter in altem Tabellenblatt löschen
Sheets(LZ).Select
zeile = 3
Do While Range("A" & zeile).Value = PN
    Rows(zeile).Select
    Selection.Delete
Loop

'Aufruf Formularblatt
Sheets("Mitarbeiterverwaltung").Select
Range("D5").Select


End Sub

Vielleicht könnte mir jemand erklären, wo mein Fehler liegt und wie ich die Schleife richtig ans Laufen bringe.

Vielen Dank im Voraus.

Grüße
Christian

[Kuwer]

Hallo Christian,

Bisher ist es so, das alles so funktioniert wie ich mir das vorstelle. Allerdings nur bei Einträgen diesich in die Zeile 3 eintragen.

- was funktioniert denn konkret nicht?

Wofür ist die Variable Anz gut?

Gruß Uwe

[Cirda]

Hallo Uwe,

ich glaube die Variable Anz war der ursprüngliche Plan die Daten einzulesen. Es handelt sich bei der Spalte J5 um eine zusammengefasste Version der gesammelten Daten in Form von (Name, Vorname, Nummer, Einheit). Da ich mit der Gesamtspalte nichts anfangen konnte, habe ich sie in einzelne Spalten aufgelöst. Somit komme ich an die Variable PN (Nummer) die mir als eindeutige ID den richtigen Datensatz raussuchen sollte.

Ich denke die Schleife funktioniert im Gesamten nicht. Sie durchläuft nur die Zeile 3 meiner Tabellen und sucht somit nur den ersten Eintrag raus.
Das Verschieben und kopieren funktioniert.

Es scheitert an der Auswahl der richtigen Zeile.

Bsp.
Mitarbeiter A: funktioniert problemlos, da er in der Tabelle in der ersten Zeile steht
Mitarbeiter Z: es wird nichts bzw. eine leere Zeile kopiert

Gruß
Christian

[Klaus-Dieter]

Hallo,

eine Beispieldatei würde es sicher erleichtern, dein Problem zu verstehen. Wenn du wirklich ernsthaft vorhast, dich mit Makros zu beschäftigen, solltest du dich als erstes vom Befehl Select verabschieden, der ist in aller Regel überflüssig.

[Cirda]

Hallo Klaus- Dieter und Uwe,

anbei eine Testdatei. Hab das ganze mal auf 3 Einheiten reduziert und den Blattschutz entfernt. Ansonsten sollte das ganze genauso wie die Originaldatei funktionieren. Ebenso habe ich alle ausgeblendeten Zellen sichtbar gemacht.

Ich bin noch am Anfang meiner "VBA Karriere" ;). Deshalb wirst du mit Sicherheit einige Ungereimtheiten finden. (wie Select etc.) Die Tabelle ist nach und nach gewachsen. Manches hatte ich als Makro aufgezeichnet und dann später einiges als Code hinzugefügt.

Gruß
Christian

[Kuwer]

Hallo Christian,

Hab ... den Blattschutz entfernt.

das hast Du leider nicht. Aber egal, denn man muss das ja nicht alles wieder aufdröseln, wenn es schon im Blatt Referenz schon da ist, woher vermutlich das DropDown auch ist. Und dann das Ganze ohne Schleifen unter Verwendung der Excelfunktion Vergleich():

Sub Mitarbeiterwechsel()

  Dim LZ As String
  Dim LZneu As String
  Dim PN As Variant
  Dim Zeile As Long
  
  'Variablen einlesen
  With Worksheets("Mitarbeiterverwaltung")
    Zeile = Application.Match(.Range("J5").Value, Worksheets("Referenz").Columns(5), 0)
    LZneu = .Range("J7").Value
    .Range("J5").Value = "Bitte auswählen"
    .Range("J7") = ""
  End With
  
  With Worksheets("Referenz")
    PN = .Cells(Zeile, 3).Value
    LZ = .Cells(Zeile, 4).Value
    .Cells(Zeile, 4).Value = LZneu
  End With
  
  'Daten verschieben
  With Worksheets(LZ)
    Zeile = Application.Match(PN, .Columns(1), 0)
    .Rows(Zeile).Copy
  End With
  With Worksheets(LZneu)
    .Rows(3).Insert Shift:=xlDown
    With .Range("A2").CurrentRegion
      If .Rows.Count > 3 Then
        .Resize(.Rows.Count - 1).Offset(1).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlyess
      End If
    End With
  End With
      
  'Mitarbeiter in alter Einheit löschen
  Worksheets(LZ).Rows(Zeile).Delete
  
End Sub

Gruß Uwe

[Cirda]

Guten Morgen,

schon mal ein Dank im vorab. Ich werde das ganze gleich mal testen.

Gruß
Christian

---

Hallo Uwe,

bis zu dieser Zeile perfektes Ergebnis

Code:

.Resize(.Rows.Count - 1).Offset(1).Sort Key1:=Range("b2"), Order1:=xlAscending, Header:=xlyess

Dann bekomm ich einen Laufzeitfehler 1004. Der Sortierbezug ist ungültig. Ich soll überprüfen ob sich der Bezug innerhalb der markierten Daten befindet.
Das werde ich jetzt mal versuchen. ;)

Gruß Christian

[schauan]

Hallöchen,

mal nur eine Frage. Wenn der Code eine Leerzeile vor Zeile 3 macht, kommt er doch gar nicht zum sortieren weil die CurrentRegion um A2 dann nur maximal 2 Zeilen hat, oder übersehe ich da was? :17:

Code:

.Rows(3).Insert Shift:=xlDown
    With .Range("A2").CurrentRegion
      If .Rows.Count > 3 Then

Ansonsten, ersetze xlyess durch xlYes und schaue, dass auch in Spalte B in der CurrentRegion Daten stehen.

[Kuwer]

Hallo Christian,

da fehlt der Punkt (rot markiert). Das xlYes hat André ja schon gefunden.

.Resize(.Rows.Count - 1).Offset(1).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlyes

Gruß Uwe