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.

Zeilenweise Abfrage mit Schleife
#1
Hallo,

ich habe folgendes Problem:

ich habe eine Exceldatei mit zwei Arbeitsblättern. Beide Arbeitsblätter enthalten dieselbe Tabellenstruktur. Im ersten Arbeitsblatt werden Projekte eingetragen und mit einem Dropdown jeweils dazu ein Status gesetzt (erledigt, in Arbeit, noch offen). Nun sollen am Ende eines Tages alle Projekte mit dem Status "erledigt" in die zweite Tabelle kopiert werden und in der ersten gelöscht werden. Bis jetzt habe ich zwar ein Makro dafür, die Zeile die ich angewählt habe zu prüfen ob erstens der Status erledigt ist und zweitens die Zeile in die zweite Tabelle ans Ende kopiert und in der ersten löscht.
Jedoch war mein Gedankengang, hier eine Schleife zu benutzen, da hakt es allerdings bei mir.
Die Schleife sollte demnach solange laufen, bis eine Zeile kommt, in der keine Status eingetragen ist. Und danach halt fortlaufend mein bereits geschriebenes Makro für das kopieren der Zeile ausführt.

Hier mal der Code für das Makro zum kopieren.


Code:
Sub Schaltfläche27_Klicken()
Dim Zelle As Range
   
   If (ActiveCell.Row > 7) Then

       If Cells(ActiveCell.Row, 12) = "erledigt" Then
   
       Worksheets("Aktionsliste_erledigt").Activate
       Cells(65000, 7).End(xlUp).Offset(1, -6).Select
       Set Zelle = ActiveCell
       Worksheets("Aktionsliste").Activate
   
       Worksheets("Aktionsliste").Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 13)).Copy _
           Destination:=Worksheets("Aktionsliste_erledigt").Range(Zelle.Address)
       
       Rows(ActiveCell.Row).Delete
   
       Else
   
       MsgBox ("Aktion ist nicht erledigt!")
   
       End If
   
   Else

   MsgBox ("unzulässiges Feld ausgewählt!")

   End If
   
End Sub
Danke schon mal im voraus.
Lucas
Antworten Top
#2
Hallo Lucas

anbei ein geanderter Makro Code von mir zum Testen.  Bitte zuerst in einer Beispieldatei testen, damit nicht versehentlich Originaldaten überschrieben werden.  Das zweite Makro "Adressen Test" bitte zuerst ausprobieren, weil ich den Copy Bereich lieber über Resize auswaehle. Ist für mich bequemer. Die Zahl 13 heisst, von der Aktiven Zelle dn Bereich um 13 Spalten nach rechts erweitern. Das geht auch nach unten Resize(5,1) heisst, fünf Zeilen nach unten.  Ebenso prüfe bitte ob die Ziel-Zelle stimmt. Sonst korrigiere das Makro bittte selbst.  

Ich habe 2 For Next Schleifen genommen, denn wenn du Zeilen Vorwaerts löschen willst klappt das nicht problemlos, weil jede gelöschte Zeile den Bereich über For i veraendert. Zum gezielten Löschen immer Rückwaerts löschen, der zweite Makro Teil!  Probier mal ob alles so klappt, würde mich freuen. Ich habe 100 Zeilen gewaehlt. Wenns mehr sind die Zahl 100 erhöhen.  Es werden nur die "erledigt" Zeilen kopiert und gelöscht!  Die anderen Zeilen bleiben unberührt.

mfg  gAst 123

Code:
Option Explicit      '9.2.2017  Gast 123  Clever Forum


Sub Schaltfläche27_Klicken()
Dim Erld As Worksheet, i, lz As Integer
Set Erld = Worksheets("Aktionsliste_erledigt")
 
  Worksheets("Aktionsliste").Select

  'Schleife für 100 Zeilen zu übertragen
  For i = 7 To 100
     If Cells(i, 12) = "erledigt" Then
        'zuerst LastZell in "Erledigt Liste suchen"
        lz = Erld.Cells(65000, 7).End(xlUp).Offset(1, -6).Row
        'danach Werte über Resize in Erledigt Tabelle kopieren
        Worksheets("Aktionsliste").Cells(i, 1).Resize(1, 13).Copy _
        Destination:=Worksheets("Aktionsliste_erledigt").Cells(lz, 1)
      Else
        Cells(i, 1).Select  '** nur zum Test
        MsgBox ("Aktion ist nicht erledigt!")
      End If
  Next i

  '2.Schleife (rückwerts!!) zum löschen von "erledigt"
  For i = 100 To 7 Step -1
     If Cells(i, 12) = "erledigt" Then Rows(i).Delete
  Next i
End Sub


Sub Adressen_Test()
lz = Worksheets("Aktionsliste_erledigt").Cells(65000, 7).End(xlUp).Offset(1, -6).Row
 
  Worksheets("Aktionsliste").Select
  Cells(7, 1).Resize(1, 13).Copy   'Wert 13 prüfen, ggf korrigieren
  MsgBox Selection.Address & "  Quell Bereich"
  Worksheets("Aktionsliste_erledigt").Select
  Cells(lz, 1).Select              'Ziel Zelle prüfen ggf. korrigieren
  MsgBox ActiveCell.Address & "  Ziel Bereich"
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:
  • Gavkon
Antworten Top
#3
Erst einmal Danke für die schnelle Hilfe! Thumps_up
Allerdings stehe ich gerade etwas auf dem Schlauch. Sobald ich die Funktion ausführen möchte, bekomme ich einen Kompilierungsfehler, dass die Function/Sub nicht definiert sei. :92:

Gruß Lucas
Antworten Top
#4
Hi Lucas,

(10.02.2017, 07:58)Gavkon schrieb: Sobald ich die Funktion ausführen möchte, bekomme ich einen Kompilierungsfehler, dass die Function/Sub nicht definiert sei. :92:

dann hast Du nicht den gesamten Code aus dem Beitrag kopiert.

Bei mir kommt kein Fehler außer der Deklaration von "lz", der auf nicht definierte Sub schließen läßt.

Mit einer Beispieldatei wäre das einfacher zu prüfen.
Also stelle bitte (D)eine (Beispiel-)Tabelle als Excel-Datei zur Verfügung, siehe die als Wichtige Themen: markierten Forums-Beiträge.
Deine Mustertabelle sollte mindestens etwa 10-15 Datensätze haben, sensible Daten anonymisiert. Vom Aufbau her muss sie aber deinem Original gleichen.
Auch ein Wunschergebnis sollte dargestellt und als solches erkennbar sein.
Die farbigen Texte sind anklickbare Links:

Hier steht, wie es geht:
Beitrag 2 WICHTIG: Arbeitsmappen zur Verfügung stellen
Beitrag 3 WICHTIG: Tabellenausschnitte und VBA-Codes im Forum einstellen

Eine Bitte:
Anstatt Screenshots ist eine Datei oder ein Ausschnitt besser!
"Du gehst ja auch nicht in die Werkstatt und gibst ein Foto Deines kaputten Autos ab!"
Antworten Top
#5
Hallo Lukas,

eine Mappe ist hier nicht nötig. Wenn Du einen Fehler hast, ist es immer gut, ggf. ein paar mehr Informationen rüberzubringen, z.B. in welcher Zeiel der Fehler auftritt und ob es weitere Auffälligkeiten gibt.

Ich nehme an, dass Du mit dem Edge unterwegs bist?
Zur Lösung habe ich gerade einen Beitrag verfasst:

http://www.clever-excel-forum.de/thread-...l#pid68032
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • Gavkon
Antworten Top
#6
Sorry, das ich mich solange nicht gemeldet habe. Das Wochenende war nur ziemlich stressig. :19:

Die Lösung von schauan hat zumindest erstmal soweit funktioniert, dass der Code an sich greift.
Es wird zwar jede Zeile (bis einschließlich 100) geprüft, jedoch bringt er auch bei den erledigten Zellen die Message-Box "Aktion nicht erledigt".

Ich habe nun mal die Datei für euch mit hochgeladen. Die Tabelle ist original nicht von mir erstellt, sondern wurde mir nur zur Verfügung gestellt. Meine Aufgabe besteht nun nur darin, diese Funktion da einzubauen. Aufgrund dessen ist die Datei auch ziemlich groß, weswegen ich sie in einem ZIP-Archiv komprimieren musste. Die Verknüpfung innerhalb der Tabelle könnt ihr ignorieren.

Gruß Lucas


Angehängte Dateien
.zip   KVP-Management.zip (Größe: 1,14 MB / Downloads: 3)
Antworten Top
#7
Hi,

(13.02.2017, 21:13)Gavkon schrieb: Die Lösung von schauan hat zumindest erstmal soweit funktioniert, dass der Code an sich greift.
Es wird zwar jede Zeile (bis einschließlich 100) geprüft, jedoch bringt er auch bei den erledigten Zellen die Message-Box "Aktion nicht erledigt".

Ich habe nun mal die Datei für euch mit hochgeladen. Die Tabelle ist original nicht von mir erstellt, sondern wurde mir nur zur Verfügung gestellt. Meine Aufgabe besteht nun nur darin, diese Funktion da einzubauen.

Nein, deswegen ist die nicht so groß, sondern, weil die Formeln bis in alle Ewigkeit runtergezogen wurden.
  • Ausschalten der Filter
  • Löschen der Filterzeile (das war seither die 7, die im Makro drin steht)
  • Löschen der Bereiche rechts und unterhalb der Tabellen
  • Umwandeln der beiden Tabellen in intelligente Tabellen (STRG-L) mit Überschriften

  • Speichern: plötzlich ist sie nur noch 84 kB groß statt 1,14 MB
Dann:
die Spalte N mit den "Erledigt" ist die Spalte 14 und nicht die 12, darum funktionierte das Makro nicht richtig, denn in 12 steht nie "erledigt".

Hier ist das angepaßte Makro, mit dem es funktioniert (das Löschen der Zeilen ist noch auskommentiert zum Testen):
Sub Schaltfläche25_Klicken()
Dim Erld As Worksheet
Dim i As Long
Dim lz As Long
Dim loLetzte As Long
Set Erld = Worksheets("Aktionsliste_erledigt")
 
 
 Worksheets("Aktionsliste").Select
 loLetzte = Sheets("Aktionsliste").Cells(Rows.Count, 14).End(xlUp).Row    ' letzte belegte in Spalte N (14)

  'Schleife für 100 Zeilen zu übertragen
  For i = 7 To loLetzte
     If Cells(i, 14) = "erledigt" Then
        'zuerst LastZell in "Erledigt Liste suchen"
        lz = Worksheets("Aktionsliste_erledigt").Cells(Rows.Count, 14).End(xlUp).Row + 1    ' erste leere in Spalte N (14)
        'danach Werte über Resize in Erledigt Tabelle kopieren
        Worksheets("Aktionsliste").Cells(i, 1).Resize(1, 15).Copy Worksheets("Aktionsliste_erledigt").Cells(lz, 1)
      Else
'         Cells(i, 1).Select  '** nur zum Test
'         MsgBox ("Aktion ist nicht erledigt!")
      End If
  Next i

  '2.Schleife (rückwärts!!) zum löschen von "erledigt"
  For i = loLetzte To 7 Step -1
'      If Cells(i, 14) = "erledigt" Then Rows(i).Delete
  Next i
End Sub

.xlsm   KVP-Management - Rabe V1.01.xlsm (Größe: 83,91 KB / Downloads: 0)
Antworten Top
#8
Hallöchen,

nur mal noch zwei Hinweise.

Bereits in der originalen Datei gibt es einige definierte Namen, die einen Fehler aufweisen. Die Frage wäre nun, ob man die einfach weglöschen kann.
Die "intelligente" Tabelle (oder Liste) ist eventuell 4 Zeilen zu kurz gefasst? Es gibt Daten bis Zeile 25, die Tabelle geht aber nur bis 21.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#9
Thumbs Up 
Ich danke euch vielmals. Jetzt hats endlich geklappt. Thumps_up
Antworten Top
#10
Hi,
(14.02.2017, 17:22)schauan schrieb: Die "intelligente" Tabelle (oder Liste) ist eventuell 4 Zeilen zu kurz gefasst? Es gibt Daten bis Zeile 25, die Tabelle geht aber nur bis 21.

stimmt, ich habe es korrigiert im Original-Beitrag.
Antworten Top


Gehe zu:


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