Auffüllen von Leerstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Rene() Dim ar As Range Dim Anfa As Single, Ende As Single With Sheets(1).UsedRange.Columns(1).SpecialCells(4) For Each ar In .Areas Anfa = Range(Split(ar.Address, ":")(0)).Offset(-1).Value Ende = Range(Split(ar.Address, ":")(1)).Offset(1).Value ar.Item(1).Offset(0, 3) = Anfa + (Ende - Anfa) / (ar.Count + 1) For i = 2 To ar.Count ar.Item(i).Offset(0, 3) = ar.Item(i - 1).Offset(0, 3).Value + (Ende - Anfa) / (ar. _ Count + 1) Next i Next End With End Sub

Sub Rene() Dim ar As Range Dim Anfa As Single, Ende As Single With Sheets(1).UsedRange.Columns(1).SpecialCells(4) For Each ar In .Areas Anfa = Range(Split(ar.Address, ":")(0)).Offset(-1).Value Ende = Range(Split(ar.Address, ":")(1)).Offset(1).Value ar.Item(1).Offset(0, 3) = Anfa + (Ende - Anfa) / (ar.Count + 1) if ar.count > 1 then For i = 2 To ar.Count ar.Item(i).Offset(0, 3) = ar.Item(i - 1).Offset(0, 3).Value + (Ende - Anfa) / (ar. _ _ Count + 1) Next i end if Next End With End Sub

Sub Rene() Dim ar As Range Dim Anfa As Single, Ende As Single With Sheets(1).UsedRange.Columns(1).SpecialCells(4) For Each ar In .Areas Select Case ar.Count Case Is = 1 Anfa = ar.Offset(-1).Value Ende = ar.Offset(1).Value ar.Value = Anfa + (Ende - Anfa) / 2 Case Is > 1 Anfa = Range(Split(ar.Address, ":")(0)).Offset(-1).Value Ende = Range(Split(ar.Address, ":")(1)).Offset(1).Value ar.Item(1).Offset(0, 0) = Anfa + (Ende - Anfa) / (ar.Count + 1) For i = 2 To ar.Count ar.Item(i).Offset(0, 0) = ar.Item(i - 1).Offset(0, 0).Value + (Ende - Anfa) / (ar. _ Count + 1) Next i End Select Next End With End Sub

Sub M_snb() sn = UsedRange.Columns(1) For Each ar In Columns(1).SpecialCells(4).Areas y = (ar.Cells(1).Offset(ar.Count).Value - ar.Cells(1).Offset(-1).Value) / (ar.Count + 1) For j = ar.Cells(1).Row To ar.Cells(1).Row + ar.Count sn(j, 1) = sn(j - 1, 1) + y Next Next UsedRange.Columns(1).Offset(, 5) = sn End Sub

Sub Rene() Dim ar As Range Dim c As Range For Each ar In ActiveSheet.UsedRange.Columns(1).SpecialCells(4).Areas y = (ar.Cells(1).Offset(ar.Count).Value - ar.Cells(1).Offset(-1).Value) / (ar.Count + 1) For Each c In ar c = c.Offset(-1) + y Next c Next ar End Sub

Sub M_snb() sn = UsedRange.Columns(1) For Each ar In Columns(1).SpecialCells(4).Areas x = ar.Cells(1).Row z = ar.Count y = (sn(x + z, 1) - sn(x - 1, 1)) / (z + 1) For j = x To x + z sn(j, 1) = sn(j - 1, 1) + y Next Next UsedRange.Columns(1).Offset(, 5) = sn End Sub

Hallo,
noch eine kleine Übung nach einer halben Flasche Sekt:
Welcher code ist schneller?
Testumgebung: 2% der Werte fehlen


Sub Test_Umgebung()
dif = 1400
With Range("A1:A60000")
.Formula = "=row()"
.Value = .Value
For i = 1 To 8
For y = 1 To i
Z = Z + dif
Cells(Z, "A").Resize(2 ^ (9 - i)).Clear
Next y
Next i
End With
End Sub

Die letzten Codes von snb und Fennek


Sub linere_Interpolation()
Start = Timer
'in Spalte A stehen Werte, einige sind leer
Dim ar As Range
Dim c As Range
For Each ar In ActiveSheet.UsedRange.Columns(1).SpecialCells(4).Areas
y = (ar.Cells(1).Offset(ar.Count).Value - ar.Cells(1).Offset(-1).Value) / (ar.Count + 1)
For Each c In ar
c = c.Offset(-1) + y
Next c
Next ar
MsgBox Timer - Start
End Sub
Sub M_snb()
Start = Timer
sn = ActiveSheet.UsedRange.Columns(1)
For Each ar In Columns(1).SpecialCells(4).Areas
y = (ar.Cells(1).Offset(ar.Count).Value - ar.Cells(1).Offset(-1).Value) / (ar.Count + 1)
For j = ar.Cells(1).Row To ar.Cells(1).Row + ar.Count
sn(j, 1) = sn(j - 1, 1) + y
Next
Next
ActiveSheet.UsedRange.Columns(1).Offset(, 5) = sn
MsgBox Timer - Start
End Sub

Die absoluten Werte sind nicht relevant, da die benutzte Hard etwas "outdated" war:
snb: 0,28 Sekunden
Fen: 0,09 Sekunden
mfg

Beliebteste Forumthreads (12 Monate)

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread