Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Auswahl richtige Schleife
#1
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:

Zitat: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
Antwortento top
#2
Hallo Christian,

(03.06.2020, 06:47)Cirda schrieb: 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
Antwortento top
#3
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
Antwortento top
#4
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.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antwortento top
#5
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


Angehängte Dateien
.xlsm   Testdatei.xlsm (Größe: 89,11 KB / Downloads: 4)
Antwortento top
#6
Hallo Christian,

(03.06.2020, 09:26)Cirda schrieb: 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
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Cirda
Antwortento top
#7
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
Antwortento top
#8
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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
  • Cirda
Antwortento top
#9
Hallo Christian,

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

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

Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Cirda
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste