VBA Code richtig? bzw. wo liegt der Fehler?

Forumthread: 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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!

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

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

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

Beliebteste Forumthreads (12 Monate)

VBA Code richtig? bzw. wo liegt der Fehler?

Forumthread: VBA Code richtig? bzw. wo liegt der Fehler?

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA Code richtig? bzw. wo liegt der Fehler?

Forumthread: VBA Code richtig? bzw. wo liegt der Fehler?

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread