Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
716to720
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
716to720
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Schleifenproblem

VBA Schleifenproblem
14.01.2006 12:47:39
Thomas
Hi,
mit dem folgenden Code soll eine Spalte mit Zahlen auf die nebenstehenden Spalten zu je 24 Zeilen aufgeteilt werden. Leider kenne ich mich mit VBA nicht so gut aus. Den Code bekam ich hier aus dem Forum.
Die Schleife wird nicht gestoppt, wenn beim Aufteilen einer Spalte weniger als 24 Werte vorhanden sind. Es kommt zu einem 400 Fehler. Über jede Hilfe bin ich dankbar.
Gruß
Thomas

Sub Div_24_List()
Dim y As Integer, i As Integer
Dim lRow As Integer
Dim divArea As Range
'Teiler definieren
y = 24
'Letze Zelle der Spalte mit der Liste
Set divArea = Range("A750")
'Hier nichts mehr anpassen
'Letzen Eintrag definieren
lRow = divArea.End(xlUp).Row
'Prüfung ob Tabelle ausreichend ist
If lRow / y > 255 Then
MsgBox "Zuviele Daten"
Set divArea = Nothing
Exit Sub
End If
For i = 1 To Application.WorksheetFunction.RoundUp(lRow, 0)
Range(Cells(y + 1, divArea.Column), Cells(lRow, divArea.Column)).Cut Cells(1, i + 1)
Set divArea = Cells(65536, i + 1)
lRow = divArea.End(xlUp).Row
Next i
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Schleifenproblem
14.01.2006 15:02:23
Thomas
Hi,
habe es selbst durch Probieren herausgefunden. Da ich gerade dabei bin PHP zu lernen, war es doch nicht so schwer, als ich gedacht hatte. ;-) Nur die Befehle lauten etwas anders:
Gruß
Thomas

Sub Div_24_List()
Dim y As Integer, i As Integer
Dim lRow As Integer
Dim divArea As Range
'Teiler definieren
y = 24
'Letze Zelle der Spalte mit der Liste
Set divArea = Range("A750")
'Hier nichts mehr anpassen
'Letzen Eintrag definieren
lRow = divArea.End(xlUp).Row
'Prüfung ob Tabelle ausreichend ist
If lRow / y > 255 Then
MsgBox "Zuviele Daten"
Set divArea = Nothing
Exit Sub
End If
For i = 1 To Application.WorksheetFunction.RoundUp(lRow, 0)
If lRow < 25 Then
Exit Sub
End If
Range(Cells(y + 1, divArea.Column), Cells(lRow, divArea.Column)).Cut Cells(1, i + 1)
Set divArea = Cells(65536, i + 1)
lRow = divArea.End(xlUp).Row
Next i
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige