PDA

Vollständige Version anzeigen : Zellen trennen in Spalte


Paul26_01
29.03.2012, 09:58
Hallo Leute,
ich habe folgende Ausgangssituation:


Spalte A
1
2 2.3.100.5
2.3.100.1
2.3.100.2
3 10.95.95.95
10.95.95.96
10.95.95.97
10.95.95.63
4 10.95.77.77
5 2.255.255.2

Diese Spalte geht noch ewig so weiter in jeder Zelle sind unterschiedliche Anzahlen von IP-Adressen eingetragen.

Ich möchte den Inhalt nun gerne nach jeder IP-Adresse trenen und auch wieder untereinander ausgeben lassen damit ich eine schöne Liste habe.

Kann mir dabei jemand behilflich sein????
Wenns geht auch mit Erklärung damit man den VBA-Code auch versteht.

Ich weiß nicht ob es wichtig ist, aber wir nutzen Excel 2003

Danke schonmal für die Hilfe
gruß
7
8
9

Paul26_01
29.03.2012, 10:03
hallo,

habe bereits das hier schon getestet:

Public Sub test()
'Überschreibt die alten Werte
Dim zelle As Range
Dim a
For Each zelle In Range("A1:A1000")
If zelle <> "" Then
a = Split(zelle, Chr(10))
Range(Cells(zelle.Row, 1), Cells(zelle.Row, UBound(a) + 1)) = a
End If
Next
End Sub

dort werden mir schon die Zellen getrennt aber dann nebeneinander ausgegeben ich brauch es aber wieder komplett als Spalte

GMG-CC
29.03.2012, 22:46
Hallo Paul,

auf der Basis deiner Vorarbeit (leicht abgeändert) habe ich folgenden Code erstellt:
Option Explicit

Public Sub NeuerTest()
'Überschreibt die alten Werte
Dim zelle As Range
Dim a, i As Long, k As Long
Dim AnzSpalten As Long 'Anzahl der gefüllten Spalten
Dim ZeilenBreite As Integer 'Anzahl der Spalten in der Zeile
Dim LetzteZeile As Long

For Each zelle In Range("A1:A" & LastRow(1))
If zelle <> "" Then
a = Split(zelle, Chr(10))
Range(Cells(zelle.Row, 1), Cells(zelle.Row, UBound(a) + 1)) = a
End If
Next

AnzSpalten = LastCol()
If AnzSpalten > 1 Then
For i = 2 To AnzSpalten 'Jede der neuen Spalten (durch Split erzeugt)
LetzteZeile = LastRow(i)
AnzSpalten = ActiveSheet.Cells(LetzteZeile, Columns.Count).End(xlToLeft).Column
If AnzSpalten > 1 Then 'In Spalte A so viele Zellen wie erforderlich einfügen

'Range(Cells(LetzteZeile + 1, 1), Cells(LetzteZeile + AnzSpalten - 1, 1)).Select

Range(Cells(LetzteZeile + 1, 1), Cells(LetzteZeile + AnzSpalten - 1, 1)).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
For k = 2 To AnzSpalten
Cells(LetzteZeile + k - 1, 1) = Cells(LetzteZeile, k)
Cells(LetzteZeile, k).ClearContents
Next k
End If
Next i
End If
End Sub

Function LastRow(Sp As Long) As Long
LastRow = ActiveSheet.Cells(Rows.Count, Sp).End(xlUp).Row
End Function

Function LastCol() As Long
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
End Function
Das sollte deinen Wünschen entsprechen. Einige Erklärungen sind im Code, ansonsten [F1] oder nachfragen.

Erich G.
30.03.2012, 00:05
Hi Paul,
wie wäre es damit?Option Explicit

Sub NochEinTest()
Dim arQ, qq As Long, zwi, ii As Long, arZ, zz As Long

' A1:Axxx in Quell-Array arQ einlesen
arQ = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
' Ziel-Array anlegen, vorläufig mit doppelter Quell-Zeilenzahl
ReDim arZ(1 To 2 * UBound(arQ))

For qq = 1 To UBound(arQ) ' Schleife über Quell-Array arQ
If arQ(qq, 1) > "" Then ' wenn qq-ter Eintrag nicht leer:
zwi = Split(arQ(qq, 1), vbLf) ' dann nach vbLf aufsplitten in Array zwi
For ii = 0 To UBound(zwi) ' Schleife über Anzahl Teile von zwi
zz = zz + 1 ' Zähle Ziel-Anzahl um 1 hoch
' Wenn Ziel-Array zu klein, verdoppeln
If zz > UBound(arZ) Then ReDim Preserve arZ(1 To 2 * zz)
arZ(zz) = zwi(ii) ' Eintrag des Teils in das Ziel-Array
Next ii
Else
zz = zz + 1 ' wenn qq-ter Eintrag leer: leere Ziel-Zeile
End If
Next qq
ReDim Preserve arZ(1 To zz) ' Ziel-Array-Größe auf zz Zeilen reduzieren
' Ausgabe z. B. ab Zelle G3 nach unten
Range("G3").Resize(UBound(arZ)) = Application.Transpose(arZ)
End Sub

Paul26_01
01.04.2012, 17:12
danke euch beiden für die Antworten =)

funktionieren beide Lösungen super

ich denke ich muss mich noch ein paar mal melden ich bin noch nicht komplett hinter VBA gestiegen :p


gruß

Paul26_01
02.04.2012, 11:50
Hallo,

ich bin nun ein bisschen weiter und habe mir folgende Sachen geschrieben:

Ich sortiere die IP-Adresse, entferne Leerzeichen und anschließend Filter ich noch doppelte IP-Adressen heraus mit folgendem Abschnitt:

'zuerst sortieren
Columns("A:A").Select
' xlDescending Sortieren von klein nach groß
' xlAscending Sortieren von groß nach klein
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Leerzeichen entfernen

Dim i As Integer
Dim letzte As Integer 'letzte Zelle mit Inhalt finden, damit das entfernen der Leerzeichen nicht zu lange dauert
letzte = Range("A65536").End(xlUp).Row
For i = 1 To letzte
Cells(i, 1).Replace What:=" ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next

'jetzt doppelte Sätze rausschmeißen
Range("A2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop


Kann man das ganze nicht sofort in eine der beiden obrigen Codes einbauen, ich denke mir mal man kann sofort im Array sortieren und doppelte Einträge löschen oder ???

Wäre nett wenn es auch wieder jemand erklären könnte falls die Befehle extrem anders sind als meine Snippets
Gruß

Erich G.
02.04.2012, 15:17
Hi Paul,
im Prinzip sind deine 'Snippets' schon in Ordnung.
Nur Code wie
Columns("A:A").Select
Selection.Sort Key1:=...
solltest du sofort ändern in
Columns("A:A").Sort Key1:=...
Damit vermeidest du diese unnsinige Selektiererei.

Dein Code arbeitet auf dem Tabellenblatt.
Da wir die IPs aber schon in einem Array haben, können wir auch gleich im Array sortieren, Leerzeichen entfernen usw.
Das geht schneller und bläht die Mappe nicht auf.

Hier der Code (ohne den Qicksort-Code, der ist in der angehängten Mappe):Option Explicit

Sub NochEinTest()
Dim arQ, qq As Long, zwi, ii As Long, arZ, zz As Long, arErg() As String

' A1:Axxx in Quell-Array arQ einlesen
arQ = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
' Ziel-Array anlegen, vorläufig mit doppelter Quell-Zeilenzahl
ReDim arZ(1 To 2 * UBound(arQ))

For qq = 1 To UBound(arQ) ' Schleife über Quell-Array arQ
arQ(qq, 1) = Replace(arQ(qq, 1), " ", "") ' alle Leerzeichen löschen #######
If arQ(qq, 1) > "" Then ' wenn qq-ter Eintrag nicht leer:
zwi = Split(arQ(qq, 1), vbLf) ' dann nach vbLf aufsplitten in Array zwi
For ii = 0 To UBound(zwi) ' Schleife über Anzahl Teile von zwi
If zwi(ii) > "" Then
zz = zz + 1 ' Zähle Ziel-Anzahl um 1 hoch
' Wenn Ziel-Array zu klein, verdoppeln
If zz > UBound(arZ) Then ReDim Preserve arZ(1 To 2 * zz)
arZ(zz) = zwi(ii) ' Eintrag des Teils in das Ziel-Array
End If
Next ii
End If
Next qq
ReDim Preserve arZ(1 To zz) ' Ziel-Array-Größe auf zz Zeilen reduzieren
Quicksort arZ, 1, zz ' Sortieren
qq = 0
For ii = 1 To zz - 1
If arZ(ii) = arZ(ii + 1) Then qq = qq + 1 ' Dubletten zählen
Next ii
ReDim arErg(1 To zz - qq, 1 To 1) ' Ausgabe-Array ohne Dubletten anlegen
qq = 0
For ii = 1 To zz - 1 ' Ausgabe-Array füllen
If arZ(ii) <> arZ(ii + 1) Then
qq = qq + 1
arErg(qq, 1) = arZ(ii)
End If
Next ii
arErg(qq + 1, 1) = arZ(ii)

Columns(2).ClearContents ' Spalte B leeren
Range("B11").Resize(UBound(arErg)) = arErg ' Ausgabe ab Zelle B11
End Sub

Paul26_01
02.04.2012, 15:49
hallo,

danke für den Tipp =)

Ich habe den Code jetzt mal eingefügt läuft echt super und deutlich schneller =)


So nun habe ich noch folgendes Problem:

Columns("A:A").EntireColumn.AutoFit 'Spalte Auto breite
Columns("A:A").Rows.AutoFit ' Zelle Autobreite


Damit lasse ich Spalten und Zellen auf Autobreite stellen hat vorher auch perfekt funktioniert,
jetzt macht er es mit dem neuen Code irgendwie nur noch vereinzelnt an was kann das jetzt liegen???

gruß

Erich G.
02.04.2012, 16:36
Hi Paul,
wo hast du diese beiden Zeilen eingefügt? Was willst du damit erreichen, was sollen sie bewirken?
Ich habs mal übersetzt/kommentiert:Sub aaTest()
Columns("A:A").EntireColumn , AutoFit 'Spalte A Autobreite
Columns(1).AutoFit ' tut das auch

Columns("A:A").Rows.AutoFit ' alle Zeilen auf Autohöhe,
' oder ' wobei die Höhe nur abhängig von Zellen
Columns(1).Rows.AutoFit ' der Spalte A berechnet wird
End Sub"Damit lasse ich Spalten und Zellen auf Autobreite stellen" stimmt so nicht.

Es gibt Zeilen, die haben Höhen. Und es gibt Spalten, die haben Breiten.
(Eine Zelle hat eine Höhe und eine Breite, weil sie zu einer Zeile und einer Spalte gehört.)

Wenn du die Spaltenbreite von Spalte A optimieren willst:
Columns("A").AutoFit ' oder
Columns(1).AutoFit
Wenn du die Spaltenbreite von A:E optimieren willst:
Columns("A:E").AutoFit

Wenn du die Zeilenhöhe von Zeile 7 optnmieren willst:
Rows(7).AutoFit
Wenn du die Zeilenhöhe der Zeilen 3:12 optimieren willst:
Rows("3:12").AutoFit

"macht er es ... irgendwie nur noch vereinzelnt an was kann das jetzt liegen?"
Bei diesen Angaben kannst nur du das wissen... :grins:

Paul26_01
02.04.2012, 16:52
hallo,

ich wollte die optimale breite und höhe bekommen für die Spalten aber leider funktioniert das ganze nicht

hier mal ein Beispielsbild wie es aussieht:

http://www10.pic-upload.de/02.04.12/qmto3k3mz2ts.jpg

gruß

Erich G.
02.04.2012, 17:19
Hi Paul
gehts's nicht ein wenig deutlicher?
Du hast nicht geantwortet auf meine Frage, wo du die Codezeilen eingefügt hast.

Soll mir das Bild sagen:
"Spalte A soll so breit werden, dass der Wert von A2 und A3 in eine Zeile passt."?

Probier doch mal am Ende der Prozedur: With ActiveSheet.UsedRange
.Columns.AutoFit
.Rows.AutoFit
End With

Paul26_01
02.04.2012, 17:51
hallo,

ich hatte den code direkt unter dem Code von dir,

aber jetzt funktioniert es danke =)


gruß