Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1112to1116
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Code richtig? bzw. wo liegt der Fehler?

VBA Code richtig? bzw. wo liegt der Fehler?
Stefsi
Hallo zusammen,
kann mir mal bitte jemand sagen wo hier der Fehler liegen könnte? Bin am verzweifeln.
Sub Test()
Dim zeile As Integer
zeile = 1
i = 0
For zeile = 1 To 1280
i = i + 1
If i = 1 Then
Tabelle1.Cells(zeile, 1) = "D"
End If
If i = 2 Then
Tabelle1.Cells(zeile, 1) = "x"
End If
If i = 3 Then
Tabelle1.Cells(zeile, 1) = "D"
End If
If i = 4 Then
Tabelle1.Cells(zeile, 1) = "D"
End If
If i = 5 Then
Tabelle1.Cells(zeile, 1) = "D"
End If
If i = 6 Then
Tabelle1.Cells(zeile, 1).Value = "x"
i = 0
End If
Next zeile
Range("A1").Select
Do Until IsEmpty(ActiveCell.Value)
If ActiveCell.Value = "D" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Vielen lieben Dank
Stefsi

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA Code richtig? bzw. wo liegt der Fehler?
06.11.2009 11:01:08
Rudi
Hallo,
teste mal:
Sub Test()
Dim zeile As Integer, rngDel As Range, i As Integer
zeile = 1
i = 0
For zeile = 1 To Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell)
i = i + 1
Select Case i
Case 1, 3, 4, 5
If rngDel Is Nothing Then
Set rngDel = Tabelle1.Cells(zeile, 1)
Else
Set rngDel = Union(rngDel, Cells(zeile, 1))
End If
End Select
If i = 6 Then i = 0
Next zeile
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi
So, so, sehr schön, aber was soll denn der...
06.11.2009 11:55:44
Luc:-?
...Fehler sein, Stefsi...?
Du erwartest doch nicht etwa, dass man deinen Code testet!?
1. Was willst du erreichen?
2. Was läuft hier falsch bzw welcher Fehler tritt auf?
3. Ggf: Welche Fehlermeldung kommt in welcher Zeile?
Anscheinend sollen sich deine Zellwertzuweisungen alle 6 Zeilen wiederholen. Das sollte eigentlich fktn. Allerdings doch eine recht aufwendige Methode des Zeilenlöschens... ;-)
Was passiert im anschließenden Do Until...Loop-Konstrukt...?
Du findest in A1 ein "D" → die Zeile wird sofort gelöscht → die nächste Zeile rückt auf A1 und ist dann hoffentlich wieder die ActiveCell. Die enthält nun "x" → A2 wird ausgewählt, was wiederum "D" enthält, worauf die Zeile in der nächsten Runde gelöscht wird und A2 dadurch jetzt wieder "D" enthält → Sofortlöschung usw bis in A2 wieder "x" aus der ehemals 6.Zeile steht. Dadurch bleibt die neue Zeile2 erhalten und A3 wird ausgewählt und in der nächsten Runde gelöscht, da A3 ja wieder "D" enthalten muss usw...
Also, ich sehe da keinen Fehler, wenn es auch das ist, was du erreichen willst...!
Allerdings kann man das Pgm ohne Änderung des Ablaufs auch deutlich kürzer schreiben...
Sub Test()
Dim i As Integer, bereich As Range, zeile As Range
With Tabelle1
Set bereich = .Range(.Cells(1, 1), .Cells(1280, 1))
End With
For Each zeile In bereich
i = i + 1
Select Case i
Case 1, 3, 4, 5: zeile = "D"
Case 2:          zeile = "x"
Case 6:          zeile = "x": i = 0
End Select
Next zeile
Range("A1").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell = "D" Then
ActiveCell.EntireRow.Delete
Else: ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Fazit: Du musst schon mitteilen, was nicht in deinem Sinne läuft...!
Gruß+schöWE, Luc :-?
PS: Hat 'ne Weile gedauert, deshalb kenne ich evtl andere Antworten in diesem Moment noch nicht... Bitte, das zu beachten!
Anzeige
AW: So, so, sehr schön, aber was soll denn der...
06.11.2009 13:20:53
Stefsi
Herzlichen Dank zusammen.
Das Problem ist dass ich immer nur die Zeile 2 und 6 aus einem SAP-Export benötige.
Das Ergebnis meines Markos ist nun folgendes:
00010 1822 BLRD C45 42X6.000 011100
Summe Warenausgänge 666 KG 213,46 %
Hier soll nun das Makro so ergänzt werden dass die unterste Zeile (also die Zeile Summe Warenausgänge etc.) nach oben in die Zeile hinter 011100 kopiert wird. (also in die Spalte G1 usw.)
Was müsste ich hierfür ergänzen?
Lieben Dank vorab.
Gruß
Steffi
Anzeige
AW: So, so, sehr schön, aber was soll denn der...
06.11.2009 13:38:04
Rudi
Hallo,
so?
Sub Test()
Dim zeile As Long, rngDel As Range, i As Integer
Application.ScreenUpdating = False
i = 0
For zeile = 1 To Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
i = i + 1
Select Case i
Case 1, 3, 4, 5
If rngDel Is Nothing Then
Set rngDel = Tabelle1.Cells(zeile, 1)
Else
Set rngDel = Union(rngDel, Cells(zeile, 1))
End If
Case 6
Range(Cells(zeile, 1), Cells(zeile, 6)).Copy Cells(zeile - 4, 7)
Set rngDel = Union(rngDel, Cells(zeile, 1))
End Select
If i = 6 Then i = 0
Next zeile
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige
AW: So, so, sehr schön, aber was soll denn der...
06.11.2009 13:44:00
Stefsi
Hallo,
er scheint ein Problem bei folgender Codezeile zu haben:
Set rngDel = Union(rngDel, Cells(zeile, 1))
Weiss aber net warum.
Danke vorab
Verbesserung
06.11.2009 14:02:41
Rudi
Hallo,
ich hab mal das ganze Konzept geändert. Geht auch viel schneller.
Sub test2()
Dim arr(), lZeile As Long, lSpalte As Long, n As Long
ReDim arr(1 To 12, 1 To UsedRange.SpecialCells(xlCellTypeLastCell).Row)
For lZeile = 1 To UsedRange.SpecialCells(xlCellTypeLastCell).Row
Select Case lZeile Mod 6
Case 2
n = n + 1
For lSpalte = 1 To 6
arr(lSpalte, n) = Cells(lZeile, lSpalte)
Next
Case 0
For lSpalte = 1 To 6
arr(lSpalte + 6, n) = Cells(lZeile, lSpalte)
Next
End Select
Next lZeile
ReDim Preserve arr(1 To 12, 1 To n)
arr = WorksheetFunction.Transpose(arr)
Worksheets.Add
ActiveSheet.Cells(1, 1).Resize(UBound(arr), 12) = arr
End Sub

Gruß
Rudi
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige