MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 13.07.2006, 09:24   #1
Stalafin
Neuer Benutzer
Neuer Benutzer
Standard VBA - Zahlen (kleiner als) filtern und löschen

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):

Code:

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
Stalafin ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.07.2006, 11:34   #2
Trantüte
MOF User
MOF User
Standard

hi stala

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

Code:

 
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

__________________

Betriebssystem: Windows XP Professionell SP2 Software: Office 2007 Professionell SP1
Trantüte ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.07.2006, 12:10   #3
Stalafin
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

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!)
Stalafin ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.07.2006, 13:01   #4
Trantüte
MOF User
MOF User
Standard

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.

Code:

 
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

__________________

Betriebssystem: Windows XP Professionell SP2 Software: Office 2007 Professionell SP1
Trantüte ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:55 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.