Herbers Excel/VBA-Archiv
VBA: Spalte ausfüllen
- VBA: Spalte ausfüllen von Jürgen vom 15.04.2003 - 10:08:11
- Re: VBA: Spalte ausfüllen von Florian vom 15.04.2003 - 10:31:25
- Re: VBA: Spalte ausfüllen von Monika Weber vom 15.04.2003 - 10:24:41
- Re: VBA: Spalte ausfüllen von Jürgen vom 15.04.2003 - 11:59:16
 |
Betrifft: VBA: Spalte ausfüllen
von: Jürgen
Geschrieben am: 15.04.2003 - 10:08:11
Hallo,
ich möchte eine Spalte per VBA wie folgt ausfüllen:
Die Spalte B soll wenn ein Wert gefunden wird mit dem Wert nach unten bis zum nächsten Wert ausgefüllt werden und zwar so lange bis das Ende der Spalte A erreicht ist, siehe Beispiel. Wie kann ich das per VBA machen.
Gruß Jürgen
A B
1 W1
2
3
4 W2
5 W3
6
7
8 W4
9
10
11
12 W5
13
A B
1 W1
2 W1
3 W1
4 W2
5 W3
6 W3
7 W3
8 W4
9 W4
10 W4
11 W4
12 W5
13 W5
|
Re: VBA: Spalte ausfüllen
von: Monika Weber
Geschrieben am: 15.04.2003 - 10:24:41
Hallo Jürgen,
hier ein möglicher Lösungsansatz:
Sub test()
Dim i As Integer
For i = 1 To ActiveSheet.UsedRange.Columns("A").Cells.Count
If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
Next i
End Sub
Es liebs Grüessli
Monika
|
|
Re: VBA: Spalte ausfüllen
von: Florian
Geschrieben am: 15.04.2003 - 10:31:25
Hi Jürgen
Sowas habe ich früher auch schon einmal gesucht und hier in dem Forum gefunden:
Sub Ausfuellen()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange.Columns("A:C").Cells
If rng.Row > 1 And IsEmpty(rng) Then
rng.Value = rng.Offset(-1, 0).Value
End If
Next rng
End Sub
Schöne Grüße
Florian
|
|
Re: VBA: Spalte ausfüllen
von: Jürgen
Geschrieben am: 15.04.2003 - 11:59:16
Hallo Monika,
danke für das Beispiel es funktioniert ... bloß bei ca. 20000 Datensätzen ist es sehr langsam. Das VBA (klappt mit dem Beispiel) was ich zustande bekommen habe ist nicht elegant aber um ein vielfaches schneller insbesondere wenns große sprünge zwischen den zu füllenden zellen gibt. Gibt es da vielleicht noch eine elegantere Lösung?
Jürgen
Sub Spalte_ausfüllen()
Application.ScreenUpdating = False
Range("b1").Activate
a = WorksheetFunction.CountA(Range("a1:a65536"))
Range("b" & a + 1) = "EndeSpalte"
For x = 1 To a
Selection.Copy
Selection.End(xlDown).Select
WertSpalte = ActiveCell.Offset(rowOffset:=-1, columnOffset:=0)
If WertSpalte = "" Then
ActiveCell.Offset(rowOffset:=-1, columnOffset:=0).Activate
Else
GoTo 1
End If
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlDown).Select
b = ActiveCell
If b = "EndeSpalte" Then GoTo 2
1
Next x
2 Range("b" & a + 1).ClearContents
Application.ScreenUpdating = True
End Sub
| |