Microsoft Excel

Herbers Excel/VBA-Archiv

Prozente kleiner 2 löschen

Betrifft: Prozente kleiner 2 löschen von: Stefanie
Geschrieben am: 08.10.2007 10:48:12

Hallo,

ich arbeite gerade eine Kostenumlagestruktur aus.

Der Bereich um den es sich handelt: G42:EQ450

Die Zeilen sehen wie folgt aus (kleiner Auszug):
905020 33,00% 942014 50,00% 943010 17,00%
930113 4,61% 930130 1,10% 930326 5,51% 931012 6,61% 931020 0,83%
931209 6,06% 932019 6,13% 932027 0,96% 932310 2,55%
930113 6,33% 930121 0,66% 930130 1,51% 930326 7,56% 931012 9,07%

Nun möchte ich, dass alle Zellen mit weniger als 2% gelöscht werden.
Damit ich dann aber keinen Schweizer Käse habe, möchte ich, dass die leeren Zellen gelöscht werden und die nächste aktive Zelle nach links verschoben wird.

So nun hoffe ich, dass sich jemand findet, der nicht nur mein Rätsel lesen, sondern auch lösen kann!!!!

Ich danke allen im Voraus!
Gruß
Steffi

  

Betrifft: AW: Prozente kleiner 2 löschen von: Rene
Geschrieben am: 08.10.2007 11:10:00

Hi Steffi,

im Makro könnte das so aussehen:

if activecell.value <= 2 then
activecell.delete
end if

Gruß
René


  

Betrifft: Daten kleiner 2% per VBA löschen von: NoNet
Geschrieben am: 08.10.2007 11:21:46

Hallo Steffi,

das folgende Makro sollte Deinen Wunsch erfüllen :
Im angegebenen Bereich werden alle Daten (also die Nr. und der %-Satz) gelöscht, die kleiner als 2% sind.
Die nachfolgenden Daten der Zeile werden nach links verschoben (allerdings nicht nach oben !)

Sub Raetsel_Nicht_nur_lesen_sondern_auch_lOesen()
    'Löscht alle Daten <2 % im angegebenen Bereich (jeweils 2 Zellen)
    Dim Bereich, Zeile, Spalte
    Set Bereich = [G42:EQ450]
    For Each ber In Bereich.SpecialCells(xlCellTypeConstants, 23).Areas
        For Zeile = ber.Row To ber.Rows.Count + ber.Row - 1
            For Spalte = ber.Column + 1 To ber.Columns.Count + ber.Column Step 2
                If Cells(Zeile, Spalte).Value < 0.02 And Cells(Zeile, Spalte).Value <> "" Then
                    Cells(Zeile, Spalte).Offset(0, -1).Resize(, 2).Delete shift:=xlToLeft
                    Spalte = Spalte - 2
                End If
            Next
        Next
    Next
End Sub
Code eingefügt mit Syntaxhighlighter 4.12

Teste das Makro bitte zunächst an einer Kopie Deiner Tabelle !!

Gruß, NoNet


  

Betrifft: AW: klappt nicht von: Stefanie
Geschrieben am: 08.10.2007 11:33:13

Hallo NoNet,

gleich zu Beginn: JA, genau so ist das angedachte Prinzip.

Leider lässt sich das Makro nicht ausführen.
Es kommt keine Fehlermeldung ... es passiert einfach gar nichts :-((

Hast du dafür auch eine Lösung?

Trotz allem schon mal vielen Dank!


  

Betrifft: Stehen auch WIRKLICH %-Werte in den Zellen ? von: NoNet
Geschrieben am: 08.10.2007 11:40:23

Hallo Steffi,

das Makro führt einen numerischen Vergleich druch, d.h. es müssen auch wirklich ZAHLEN in den Zellen stehen.

Hier mein Testergebnis (probiere es bitte auch mal damit) :

Tabelleninhalt VORHER :

GHIJKLMNOPQ
4290502033,00%94201450,00%94301017,00%
439301134,61%9301301,10%9303265,51%9310126,61%9310200,83%
449312096,06%9320196,13%9320270,96%9323102,55%
459301136,33%9301210,66%9301301,51%9303267,56%9310129,07%
46x1%y2%z1,50%a1,50%b1,50%
47

Tabelle eingefügt mit Syntaxhighlighter 4.12


Tabelleninhalt NACHHER :

GHIJKLMNOPQ
4290502033,00%94201450,00%94301017,00%
439301134,61%9303265,51%9310126,61%
449312096,06%9320196,13%9323102,55%
459301136,33%9303267,56%9310129,07%
46y2%
47

Tabelle eingefügt mit Syntaxhighlighter 4.12


Gruß, NoNet


  

Betrifft: AW: Stehen auch WIRKLICH %-Werte in den Zellen ? von: Stefanie
Geschrieben am: 08.10.2007 13:01:24

Hallo,

also ich habe es nochmal überprüft, es sind alles %-Werte.
Als ich es erneut versucht habe kam folgende Fehlermeldung:

Laufzeitfehler '1004'
Keine Zellen gefunden.

Und nachfolgende Zeile wird dann markiert:

For Each ber In Bereich.SpecialCells(xlCellTypeConstants, 23).Areas



  

Betrifft: OK, dann sind das wohl BERECHNETE Werte ? von: NoNet
Geschrieben am: 08.10.2007 13:08:53

Hallo Steffi,

aus Performancegründen durchsucht mein Makro nur die gefüllten Zellen (Konstante Werte), aber keine LEERZELLEN und auch keine berechneten Zellen (also keine Formelergebnisse).

Wenn das Makro keine Zellen findet, dann vermute ich mal, dass es sich bei den %-Werten um Formelergebnisse handelt ?

Dann empfehle ich Dir folgende Änderung im Code :

For Each ber In Union(Bereich.SpecialCells(xlCellTypeConstants, 23), _
    Bereich.SpecialCells(xlCellTypeFormulas, 23)).Areas

Gruß, NoNet


  

Betrifft: AW: OK, dann sind das wohl BERECHNETE Werte ? von: Stefanie
Geschrieben am: 08.10.2007 13:52:08

Leider kommt auch hier der gleiche Fehler.
Das Problem ist, dass ich die Datei zur Weiterbearbeitung erhalten habe und nicht mehr in Erfahrung bringen kann, was im Vorfeld damit gemacht worden ist.

Ich kann nur sagen, was ich bis dato gemacht habe:
Am Anfang waren es als Text gespeicherte Zahlen, das habe ich geändert.
Dann habe ich die Zahlen erneut als Prozent ausgewiesen; Format - Zellen - Prozent

Ich habe das Makro sowohl mit und ohne Prozent probiert.

Hat es damit was zu zun?


  

Betrifft: Dann musst Du die Zellen als ZAHL umwandeln von: NoNet
Geschrieben am: 08.10.2007 14:00:39

Hallo Steffi,

die Info, dass diese Zellen zunächst als Textformatiert waren, könnte die Lösung bringen :

Markiere mal eine einzelne Spalte (mit %-Werten), wähle Menüpunkt "Daten - Text in Spalten - Getrennt - Fertigstellen" und teste das Makro dann. Falls das dann klappt, musst Du das für jede %-Spalte einzeln wiederholen.

Gruß, NoNet


  

Betrifft: AW: leider nicht von: Stefanie
Geschrieben am: 08.10.2007 14:20:13

Vorab vielen Dank für die Mühe...!

Leider funktioniert auch dieser Schritt nicht.
Nun kommt auch keine Fehlermeldung mehr, es passiert lediglich gar nichts!

Übrigens funktionieren die beiden anderen Makros auch nicht!!!


  

Betrifft: Dann lade die Datei bitte mal hoch... von: NoNet
Geschrieben am: 08.10.2007 14:34:09

Hallo Steffi,

das wird ja immer dubioser ! Wenn Du nun weitere Vorschläge erwartest, solltest Du die Mappe mal bei herber hochladen und den Link hier posten (natürlich nur dann, wenn diese keine datenschutzrelevanten Daten enthält, aber diese kannst Du ja zuvor löschen !).

Gruß, NoNet


  

Betrifft: AW: Dann lade die Datei bitte mal hoch... von: Stefanie
Geschrieben am: 08.10.2007 14:59:08

https://www.herber.de/bbs/user/46609.xls


Ich habe die entsprechenden Daten kopieren und in eine neue Tabelle einfügen müssen, da die Datei zu groß war.
Ich hoffe es funktioniert trotz allem.


  

Betrifft: AW: Dann lade die Datei bitte mal hoch... von: Rene
Geschrieben am: 08.10.2007 15:41:54

Hi Steffi,

hast du sowas wie in der angehängte Mappe gemeint?
Starte mal das Makro.
Das löscht dir die Zelle mit weniger als 2 Prozent und schiebt die Zellen nach links.
https://www.herber.de/bbs/user/46614.xls

Gruß
René


  

Betrifft: "Typen unverträglich" von: Stefanie
Geschrieben am: 08.10.2007 15:54:12

Man man man so langsam wird es mir echt peinlich, erneut die selbe Antwort zu geben!!!
Es klappt leider nicht.

Es ist zwar das erste Mal, dass man das typische "Rattern" in der Tabelle sieht, bricht aber nach ca. 15sek
ab mit der Meldung:

"Typen unverträglich"

Was ist eigentlich, wenn derjenige der die Datei zuerst bearbeitet hat, ein Makro geschrieben hat, z.B. um an die Prozentsätze zu kommen?
Ist das damit gemeint?

Ich weiß halt leider echt nicht, was die Person gemacht hat.


  

Betrifft: Hmm... - klappt bei mir auch nicht :-( von: NoNet
Geschrieben am: 08.10.2007 16:17:42

Hallo Stefanie,

die Datei scheint wirklich sehr verworren zu sein :
Mein Makro klappt hier auch nicht ! Es scheint tatsächlich an den Formaten der Zelle zu liegen :
Manche werden als ZAHL erkannt, manche nicht.
Ich habe schon versucht, manuell und auch per VBA die Daten per "Text in Spalten" zu formatieren : ohne Erfolg. Auch ein Kopieren der reinen Werte (ohne Formatierungen !) in eine neue Mappe bringt keine Besserung ! Manche Zellen werden als %-Wert kopiert, manche als ZAHL - eine Systematik ist nicht zu erkennen :-( Selbst das Multiplizieren mit 1 (= eine Standard-Methode bei unstimmigen Formatierungen) klappt nicht !
Also irgendwie ist das Format der Tabelle total korrupt ! Ich bin auch nicht sicher, ob man das reparieren kann (und ich habe schon sehr viele Mappen repariert !!). Ich experimentiere noch ein Wenig damit...

Gruß, NoNet


  

Betrifft: AW: Hmm... - klappt bei mir auch nicht :-( von: Rene
Geschrieben am: 08.10.2007 16:45:10

Hi Steffi,

ich glaub ich habs.
Schau es dir mal an.
Einach das Makro starten und warten bis der Fortschrittsbalken verschwunden ist,.

https://www.herber.de/bbs/user/46619.xls

Gruß
René


  

Betrifft: AW: "Typen unverträglich" von: Beverly
Geschrieben am: 08.10.2007 17:04:12

Hi Stefanie,

Sub umwandeln_loeschen()
    Dim raZelle As Range
    Dim raZellen As Range
    For Each raZelle In ActiveSheet.UsedRange
        If Right(raZelle, 1) = "%" Then
            Cells(raZelle.Row, raZelle.Column) = CDbl(Left(raZelle, Len(raZelle) - 1)) / 100
            Cells(raZelle.Row, raZelle.Column).NumberFormat = "0.00%"
        End If
    Next raZelle
    For Each raZelle In ActiveSheet.UsedRange
        If raZelle < 0.02 And raZelle > 0 Then
            If raZellen Is Nothing Then
                Set raZellen = Union(raZelle, raZelle.Offset(0, -1))
            Else
                Set raZellen = Union(raZellen, raZelle, raZelle.Offset(0, -1))
            End If
        End If
    Next raZelle
    If Not raZellen Is Nothing Then raZellen.Delete shift:=xlShiftToLeft
    Set raZellen = Nothing
End Sub



Bis später,
Karin


  

Betrifft: AW: Prozente kleiner 2 löschen von: Beverly
Geschrieben am: 08.10.2007 11:37:15

Hi Steffi,

eine andere Möglichkeit

Sub loeschen()
    Dim raZelle As Range
    Dim raZellen As Range
    For Each raZelle In ActiveSheet.UsedRange
        If raZelle < 0.02 And raZelle > 0 Then
            If raZellen Is Nothing Then
                Set raZellen = Union(raZelle, raZelle.Offset(0, -1))
            Else
                Set raZellen = Union(raZellen, raZelle, raZelle.Offset(0, -1))
            End If
        End If
    Next raZelle
    If Not raZellen Is Nothing Then raZellen.Delete shift:=xlShiftToLeft  ' hier werden alle  _
Zellen auf einmal gelöscht und verschoben
    Set raZellen = Nothing
End Sub



________________________________________
GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Prozente kleiner 2 löschen von: Daniel
Geschrieben am: 08.10.2007 23:48:56

Hallo Steffi
scheint ja ein schwieriger Fall zu sein.
Leider kann ich deine Origingal-Datei nicht mehr hochladen, aber ich hoffe, das Beispiel von NoNet entspricht noch dieser.
ich hab mal was gebastelt, mit der Datei funktionierts es auch recht zügig, hoffentlich dann auch im Original.

Anzumerken ist, daß die Originaldaten nicht verändert werden, sondern die Werte in Tabelle2 übertragen und dort bearbeitet werden. Dadurch kann ich mit Formeln arbeiten und spare mir die Schleifen, dh. das Makro ist kurz und sollte recht flott sein.

Hier der Code:

Sub Test()

With Sheets("tabelle2").Range(Sheets("Tabelle1").UsedRange.Address)
    .FormulaR1C1 = "=IF(Tabelle1!RC="""","""",IF(ISERROR(VALUE(Tabelle1!RC)),Tabelle1!RC,IF( _
VALUE(Tabelle1!RC)<0.02,TRUE,Tabelle1!RC)))"
    Sheets("Tabelle1").UsedRange.Copy
    .PasteSpecial xlPasteFormats
    .Formula = .Value
    .SpecialCells(xlCellTypeConstants, 4).Delete shift:=xlToLeft
End With

End Sub




und hier die Datei:
https://www.herber.de/bbs/user/46622.xls
Gruß, Daniel


  

Betrifft: DANKE DANKE DANKE von: Stefanie
Geschrieben am: 09.10.2007 09:04:47

Ich war gestern nicht mehr am Platz, so dass ich es jetzt erst testen konnte.

Sowohl das Makro von Rene als auch das von Beverly klappt.



1000x DANKE



Ich glaube wenn ich das manuell hätte machen müssen, würde ich nächste Woche noch sitzen!



Gruß

Steffi