PDA

Vollständige Version anzeigen : Zahlen (kleiner als) filtern und löschen


Stalafin
13.07.2006, 09:24
Ich habe mir gerade ein pascalsches Dreieck mit VBA und Excel gebaut. Das Problem bei meinem Algorithmus ist, dass überflüssige Nullen ("0") in einige Zellen reingeschrieben werden.
Diese würde ich gerne löschen.

Dies ist zwar nicht ganz sauber, aber ich schaffe es im Moment nicht, den Algorithmus entsprechend zu korrigieren.

Mit welchem Befehl also kann ich die Nullen aus der Tabelle (variable Spalten- und Zeilenanzahl) rausfiltern und löschen lassen?

Wenn es jemanden interessiert - anbei mein Sourcecode (das Kommentieren habe ich mir vorerst gespart):

Public Sub Dreieck()
Dim n As Long
Dim triangletip As Long
Dim triangleedge As Long
Dim maxlength As Long
Dim maxlengthcounter As Long
Dim columncounter As Long
Dim cellwriter As Long

Tabelle4.UsedRange.Delete

n = Sheets("PascalschesDreieck").Cells(1, 1).Value
maxlength = n + 1 '5
maxlengthcounter = 0
columncounter = 0

If n < 0 Then
Exit Sub
MsgBox "Für kleinere Werte als 0 ist dies nicht möglich!"

Else
triangletip = n + 1 '5
End If

triangleedge = triangletip '5



Do

Do
If a And b Then Stop
If maxlengthcounter = 0 Then
Sheets("Pascal").Cells(maxlengthcounter + 1, triangletip).Value = 1

Else
i = triangleedge '4
While i - 1 < (n * 2 + 1) '7
If i = 1 Then
Sheets("Pascal").Cells(maxlengthcounter + 1, i).Value = Sheets("Pascal").Cells(maxlengthcounter, i + 1)
Else
Sheets("Pascal").Cells(maxlengthcounter + 1, i).Value = Sheets("Pascal").Cells(maxlengthcounter, i - 1).Value + Sheets("Pascal").Cells(maxlengthcounter, i + 1)
End If
i = i + 2 '6
Wend
columncounter = columncounter + 1

End If


Loop Until columncounter = maxlengthcounter
triangleedge = triangleedge - 1 '4
columncounter = 0
maxlengthcounter = maxlengthcounter + 1 '1
Loop Until maxlengthcounter = maxlength

End Sub

Trantüte
13.07.2006, 11:34
hi stala

ich habe den code mal folgendermaßen abgeändert:


Public Sub Dreieck()
Dim n As Long
Dim triangletip As Long
Dim triangleedge As Long
Dim maxlength As Long
Dim maxlengthcounter As Long
Dim columncounter As Long
Dim cellwriter As Long

Tabelle4.UsedRange.Delete

n = Sheets("PascalschesDreieck").Cells(1, 1).Value
maxlength = n + 1 '5
maxlengthcounter = 0
columncounter = 0

If n < 0 Then
Exit Sub
MsgBox "Für kleinere Werte als 0 ist dies nicht möglich!"

Else
triangletip = n + 1 '5
End If

triangleedge = triangletip '5



Do

Do
If a And b Then Stop
If maxlengthcounter = 0 Then
Sheets("Pascal").Cells(maxlengthcounter + 1, triangletip).Value = 1

Else
i = triangleedge '4
While i - 1 < (n * 2 + 1) '7
If i = 1 Then
If Sheets("Pascal").Cells(maxlengthcounter, i + 1) <> 0 Then
Sheets("Pascal").Cells(maxlengthcounter + 1, i).Value = _
Sheets("Pascal").Cells(maxlengthcounter, i + 1)
End If
Else
If Sheets("Pascal").Cells(maxlengthcounter, i - 1).Value + _
Sheets("Pascal").Cells(maxlengthcounter, i + 1) <> 0 Then
Sheets("Pascal").Cells(maxlengthcounter + 1, i).Value = _
Sheets("Pascal").Cells(maxlengthcounter, i - 1).Value + _
Sheets("Pascal").Cells(maxlengthcounter, i + 1)
End If
End If
i = i + 2 '6
Wend
columncounter = columncounter + 1

End If


Loop Until columncounter = maxlengthcounter
triangleedge = triangleedge - 1 '4
columncounter = 0
maxlengthcounter = maxlengthcounter + 1 '1
Loop Until maxlengthcounter = maxlength

End Sub



orginal hat der code bei mir nicht funktioniert deshalb mußte ich ein paar stellen auskommentieren (tabelle4.usedrange... und if a and b then stop) aber normal müßte es so trotzdem funtionieren.

mfg david

Stalafin
13.07.2006, 12:10
Jut, Vielen Dank schonmal!

Ich hätte dann aber noch eine Frage:

Ich die Zelle mit der größten vorhandenen Zahl auf die optimale Größe einstellen.

Anschließend möchte ich die Breite und Höhe dieser Zelle auslesen und auf die anderen Zellen übertragen, sodass anschließend alle Zellen die gleiche Größe haben.

Hat da vielleicht jemand eine Idee?

(alles automatisch und via VBA natürlich!)

Trantüte
13.07.2006, 13:01
hi stala

hier mal ein kleiner code den ich geschrieben habe um die zellen der größten anzupassen. die bereiche mußt du natürlcih deinen bedürfnissen anpassen.


Sub Zellen_Anpassen()

Dim r_Zelle As Range
Dim dblBreite As Double
Dim dblHoehe As Double
Dim r_Spalte As Range
Dim r_Zeile As Range

With ThisWorkbook.Worksheets("Tabelle1")

.UsedRange.Columns.AutoFit
.UsedRange.Rows.AutoFit

For Each r_Spalte In .UsedRange.Columns
If dblBreite < r_Spalte.ColumnWidth Then
dblBreite = r_Spalte.ColumnWidth
End If
Next r_Spalte

For Each r_Zeile In .UsedRange.Rows
If dblHoehe < r_Zeile.RowHeight Then
dblHoehe = r_Zeile.RowHeight
End If
Next r_Zeile

.UsedRange.ColumnWidth = dblBreite
.UsedRange.RowHeight = dblHoehe

End With

End Sub


mfg david