Liste ohne Lücken anzeigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column <> 1 And Target.Column <> 4 Then Exit Sub '1 und 4 anpassen Dim Spalte, Zei As Long, n As Long Spalte = Range("W1:W" & Range("W65536").End(xlUp).Row) Worksheets("Tabelle1").Columns(1).ClearContents ' 1 anpassen For n = 1 To UBound(Spalte) If Spalte(n, 1) <> "" And Spalte(n, 1) <> 0 Then Zei = Zei + 1 Worksheets("Tabelle1").Range("A" & Zei) = Spalte(n, 1) ' A anpassen End If Next n End Sub

Private Sub Worksheet_Calculate() Dim Spalte, Zei As Long, n As Long Spalte = Range("W1:W" & Range("W65536").End(xlUp).Row) Worksheets("Tabelle1").Columns(1).ClearContents ' 1 anpassen For n = 1 To UBound(Spalte) If Spalte(n, 1) <> "" And Spalte(n, 1) <> 0 Then Zei = Zei + 1 Worksheets("Tabelle1").Range("A" & Zei) = Spalte(n, 1) ' A anpassen End If Next n End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Address <> "$C$1" Then Exit Sub ' $C$1 anpassen Dim Spalte, Zei As Long, n As Long Spalte = Range("W1:W" & Range("W65536").End(xlUp).Row) Worksheets("Tabelle1").Columns(1).ClearContents ' 1 anpassen For n = 1 To UBound(Spalte) If Spalte(n, 1) <> "" And Spalte(n, 1) <> 0 Then Zei = Zei + 1 Worksheets("Tabelle1").Range("A" & Zei) = Spalte(n, 1) ' A anpassen End If Next n End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Address <> "$C$1" Then Exit Sub ' $C$1 anpassen Dim Spalte, Zei As Long, n As Long Spalte = Range("W1:W" & Range("W65536").End(xlUp).Row) Worksheets("Tabelle1").Columns(1).ClearContents ' 1 anpassen For n = 1 To UBound(Spalte) If Spalte(n, 1) <> "" And Spalte(n, 1) <> 0 And TypeName(Spalte(n, 1)) <> "Error" Then Zei = Zei + 1 Worksheets("Tabelle1").Range("A" & Zei) = Spalte(n, 1) ' A anpassen End If Next n End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Address <> "$C$1" Then Exit Sub ' $C$1 anpassen Dim Zelle, Spalte, Zei As Long, n As Long For Each Zelle In Worksheets("Tabelle2").UsedRange If TypeName(Zelle.Value) = "Error" Then MsgBox "Fehler in " & Zelle.Address(0, 0) Exit Sub End If Next Zelle Spalte = Range("W1:W" & Range("W65536").End(xlUp).Row) Worksheets("Tabelle1").Columns(1).ClearContents ' 1 anpassen For n = 1 To UBound(Spalte) If Spalte(n, 1) <> "" And Spalte(n, 1) <> 0 Then Zei = Zei + 1 Worksheets("Tabelle1").Range("A" & Zei) = Spalte(n, 1) ' A anpassen End If Next n End Sub

...aber da es sich hier um eine Erweiterung handelt, wäre es noch besser gewesen, Daniel,
du hättest das gleich gesagt, dann hättest du die Lösung schon!
Wenn es sich nur um die genannte Erweiterung handelt (und später nicht noch mehr hinzukommen sollen...), müsstest du den 2.Teil des Pgms (ab Spalte =...) nur 2x aufschreiben und beim 2. die entsprechenden Änderungen vornehmen. Ansonsten wäre es sinnvoller eine Überschleife über diesen Codeteil zu konstruieren, die alle Spaltenpaare (W/A, X/B,...) nacheinander abhandelt. Dazu wären am Anfang des Pgms (übrigens: Die Dim-Anweisungen wdn stets als erste abgearbeitet und sollten deshalb auch am PgmAnfang stehen! - eine Frage des PgmStils) entweder 2 korrespondierende VariantVariablen mit Arrays von Spaltenbezeichnungen zu bilden, z.B...


Dim i as Long, spp1, spp2
spp1 = Array("W", "X", ...): spp2 = Array("A", "B", ...)

..., und die Spaltenbuchstaben in den betroffenen Zeilen entsprechend auszutauschen...


For i = 0 To UBound(spp1)
Spalte = Range(spp1(i) & "1:" & spp1(i) & Range(spp1(i) & "65536").End(xlUp).Row)
Worksheets("Tabelle1").Range(spp2(i) & Zei) = Spalte(n, 1)
Next i

...(auch für unzusammenhängende Spaltenbereiche gut geeignet) oder (bei zusammenhängenden Spaltenbereichen) den Überzyklus gleich auf einen Bereich "W:..." zu beziehen, dessen einzelne Spalten nacheinander abgearbeitet wdn (For Each sp in Range("W:X").Columns). Dann müsste das Folgende aber stärker geändert wdn (...das kann ja Reinhard machen ;-) ).
Gruß Luc :-?

Beliebteste Forumthreads (12 Monate)

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread