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.

VBA Zellen leeren und Zeile löschen
#1
Hey guys,

ich habe ein VBA Projekt und derzeit zwei Probleme auf der Zielgraden

anbei mein derzeitiger Code 
Code:
Sub Fehlzeiten_löschen()
Dim c As Range
   For Each c In ActiveSheet.UsedRange.Cells
   
       If InStr(LCase(c.Value), "#") <> 0 Then
       Range(c, c.Offset(0, 0)).ClearContents
       End If
       
       If InStr(LCase(c.Value), "fs") <> 0 Then
           Range(c, c.Offset(0, 1)).ClearContents
       End If
       
       If InStr(LCase(c.Value), "kr") <> 0 Then
       Range(c, c.Offset(0, 1)).ClearContents
       
       End If
       
       If InStr(LCase(c.Value), "ez") <> 0 Then
       Range(c, c.Offset(0, 1)).ClearContents
       
       End If
       
       If InStr(LCase(c.Value), "uf") <> 0 Then
       Range(c, c.Offset(0, 1)).ClearContents
       
       End If
       
       If InStr(LCase(c.Value), "ub") <> 0 Then
       Range(c, c.Offset(0, 1)).ClearContents
       
       End If
       
       If InStr(LCase(c.Value), "k1") <> 0 Then
       Range(c, c.Offset(0, 1)).ClearContents
End If




Next c

Dim Bereich As Range
Set Bereich = Union(Columns(4), Columns(6), Columns(8), Columns(10), Columns(12), Columns(14), Columns(16))
Bereich.Delete


 
End Sub
1. Mit dem ersten Teil möchte ich überall wenn "EZ", "FS"; "UB"; "UF"; etc. in den Zellen steht diese Zelle mit dem jeweiligen Inhalt und die Zelle rechts daneben leeren.
       - das klappt soweit ganz gut. das einzige was mich stört ist, dass teilweise in den Spalten B und C Namen (anonymisiert)  gelöscht werden. Dabei brauche ich Hilfe, dass es nicht mehr passiert

2. Mit dem zweiten Teil möchte ich, dass die Reihen wo in der Überschrift S1, S2, S3 etc. steht gelöscht werden. DAs funktioniert soweit.

3. Ich möchte einen dritten Teil hinzufügen, der anschließend alle Zeilen löscht wenn in Spalte D:J für diese Zeile keine Werte hat. Wenn in Spalte D, E, F entwas steht soll natürlich alles bleiben. Wenn ich Spalte D, E, F, G, H, I, J nichts steht, dann soll die Zeile einschließlich Namen gelöscht werden.

ich hoffe das war verstädnlich


Angehängte Dateien
.xlsx   VBA Zellen löschen und Zeilen löschen.xlsx (Größe: 21,34 KB / Downloads: 2)
Antworten Top
#2
Hi,

CHASiN1994 schrieb:...dass teilweise in den Spalten B und C Namen (anonymisiert)  gelöscht werden...

Ist Dir klar warum?

a) Du durchläufst diese Zellen - Warum überhaupt?
b) Du suchst nach Zeichenketten und wenn gefunden, dann diese Zelleninhalte löschen und die daneben
    (Zwischenfrage: Was passiert bei Namen wie: "Alofs, Kranz, Huber")
c) Warum LCase() - Schau dir InStr() und dessen Möglichkeiten an (Stichwort: vbTextCompare)


Das sind Basics. Die lassen sich im Handbuch nachlesen.
gruß
Marco
Antworten Top
#3
Hallo

Zitat:ich hoffe das war verstädnlich

Sollte ich die Aufgab richtig verstanden haben erkennt man es sofort am funktionierenden Code! Bitte zuerst die Originaldaten ins Beispiel kopieren und dort testen ob das Löschen der Leerzeilen ohne Stunden einwandfrei funktioniert!  Im Beispiel passiert nix an Originaldaten wenn das Makro noch einen Fehler hat. Viel Spass beim testen.

mfg  Gast 123

Code:
Option Explicit      '11.7.2019   Gast 123   für Clever Forum


'"EZ", "FS"; "UB"; "UF"; "KR"; "K1"  Löschen
'Leerzeilen ohne Stundenzahl mit löschen

Sub Fehlzeiten_löschen()
Dim AC As Range, lz1 As Long
Dim Bereich As Range, j As Long
  'LastZelle in Spalte A ermitteln
  lz1 = Cells(Rows.Count, 1).End(xlUp).Row
 
  'Schleife auf Spalte D-Q begrenzen!
  For Each AC In ActiveSheet.Range("D2:Q" & lz1)
      If InStr(LCase(AC.Value), "#") <> 0 Then
         AC.ClearContents
      ElseIf InStr(LCase(AC.Value), "fs") <> 0 Then
          AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "ez") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "uf") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "ub") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "kr") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "k1") <> 0 Then
         AC.Offset(0, 1).ClearContents
      End If
  Next AC

  Set Bereich = Union(Columns(4), Columns(6), Columns(8), Columns(10), Columns(12), Columns(14), Columns(16))
  Bereich.Delete

  'Schleife für -RÜCKWAERTS- löschen leerer Zellen
  'vorwaerts NICHT möglich, vraendert Zeilen Bezug!!
  For j = lz1 To 2 Step -1   'Rückwarts!!
     If WorksheetFunction.Sum(Cells(j, 4).Resize(1, 8)) = 0 Then
        Rows(j).Delete shift:=xlUp
     End If
  Next j

End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:
  • CHASiN1994
Antworten Top
#4
(11.07.2019, 10:18)Gast 123 schrieb: Hallo


Sollte ich die Aufgab richtig verstanden haben erkennt man es sofort am funktionierenden Code! Bitte zuerst die Originaldaten ins Beispiel kopieren und dort testen ob das Löschen der Leerzeilen ohne Stunden einwandfrei funktioniert!  Im Beispiel passiert nix an Originaldaten wenn das Makro noch einen Fehler hat. Viel Spass beim testen.

mfg  Gast 123

Code:
Option Explicit      '11.7.2019   Gast 123   für Clever Forum


'"EZ", "FS"; "UB"; "UF"; "KR"; "K1"  Löschen
'Leerzeilen ohne Stundenzahl mit löschen

Sub Fehlzeiten_löschen()
Dim AC As Range, lz1 As Long
Dim Bereich As Range, j As Long
  'LastZelle in Spalte A ermitteln
  lz1 = Cells(Rows.Count, 1).End(xlUp).Row
 
  'Schleife auf Spalte D-Q begrenzen!
  For Each AC In ActiveSheet.Range("D2:Q" & lz1)
      If InStr(LCase(AC.Value), "#") <> 0 Then
         AC.ClearContents
      ElseIf InStr(LCase(AC.Value), "fs") <> 0 Then
          AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "ez") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "uf") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "ub") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "kr") <> 0 Then
         AC.Offset(0, 1).ClearContents
      ElseIf InStr(LCase(AC.Value), "k1") <> 0 Then
         AC.Offset(0, 1).ClearContents
      End If
  Next AC

  Set Bereich = Union(Columns(4), Columns(6), Columns(8), Columns(10), Columns(12), Columns(14), Columns(16))
  Bereich.Delete

  'Schleife für -RÜCKWAERTS- löschen leerer Zellen
  'vorwaerts NICHT möglich, vraendert Zeilen Bezug!!
  For j = lz1 To 2 Step -1   'Rückwarts!!
     If WorksheetFunction.Sum(Cells(j, 4).Resize(1, 8)) = 0 Then
        Rows(j).Delete shift:=xlUp
     End If
  Next j

End Sub

funktioniert super danke :)
Antworten Top


Gehe zu:


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