VBA MS Excel

Hallo zusammen,

Kann mir jemand helfen
Ich möchte ein Programm schreiben, das in einer Escel-Tabelle die Zellen erkennt, die nicht vollständig angezeigt werden (z.B. bei überlangen Texten).
Ist das überhaupt möglich? und wie kann ich diese Zellen erkennen??

Danke im Voraus

 

Hallo Lang76,

Wie man das direkt auslesen könnte... mir ist nichts bekannt.
Je nach dem was Du erreichen willst, hilft vielleicht das weiter >

Worksheets("Sheet1").Columns("A:P").AutoFit
...passt die Spaltenbreite in den Spalten A bis P an die tatsächliche Länge des grössten Eintrags an.

Code:

maxLen = 12     'max Anzahl von angezeigten Buchstaben
For Each xCell In Range("B20:G60")
    If Len(xCell.Value) > maxLen Then
        'Code für das, was getan werden soll...
    End If
Next

...prüft in allen Zellen im Bereich, ob die Anzahl Zeichen grösser ist als die angegebene Maximal-Anzahl.
Absolut richtig funktionieren kann das natürlich nur, wenn im Blatt eine Schriftart mit fester Buchstabenbreite gewählt ist.

Gruss Urs

 

Hallo Urs2,
danke für deine Antwort. Ich möchte aber wissen, ob es möglich ist zu erkennen, ob Zelle vollständig angezeigt wird oder nicht, da bei unterschiedlichen Zeichen wird unterschiedliche Menge dieser Zeichen sichtbar sein. Z. B. wenn ich in den Text 800 mal "!" schreibe, werden sie alle angezeigt, bei "O" werden nur 224 angezeigt und rest wird ausgeblendet.

Gruß

 

Hallo Lang76,

Deine nachgeschobenen Erläuterungen hatte ich doch schon in meiner Antwort berücksichtigt und auch explizit erwähnt.

Eine neue Information wäre die Antwort auf meine implizite Frage gewesen >
"Was willst Du damit bezwecken - was soll gemacht werden, wenn... ?"

Gruss Urs

 

Hallo Urs2,

ich möchte die Zellen, die nicht vollständig angezeigt sind erkennen und die Zeilen, die diese Zellen enthalten, löschen. Es ist vorher nicht bekannt wie groß die Zellen sind und wie lang der Text ist, der da drin steht.

Gruß

 

Hallo Lang76,

Wie schon geschrieben, ist mir keine Möglichkeit bekannt, das direkt auszulesen... was nicht absolut sein muss !

Dieser Code funktioniert bei mir, aber nur unter diesen Bedingungen >

1. Die Schriftart im zu bearbeitenden Bereich darf nicht proportional sein.
Ich habe die "Monospace821 BT" gewählt, die sieht einigermassen gut aus

2. Du musst den Wert xFactor mit Deinen Schriftart und -grösse im Blatt testen und berechnen >
- fülle eine Zelle mit 50 Zeichen und verschiebe die Spaltenbreite so, dass alle sichtbar sind
- wenn Du jetzt auf den Trennstrich in der Spaltenüberschrift klickst, werden zwei Zahlen angezeigt
- bei mir steht da..... Breite: 55.56 (507 Pixel)
- teile die Anzahl Zeichen (=50) durch die Breite (=55.56) >>> das ist der xFactor (bei mir = 0.8999 also 0.9)
> im Code eintragen

In einer Kopie Deiner Nutzdatei, kopiere diesen Code im VB-Editor in den Ordner des Arbeitsblattes

Code:

Dim rngTotal As Range, xCell As Range, xFactor As Double

            'entweder diese Zeile,
            'wenn die zu bearbeitenden Zellen hier festgelegt werden sollen
'Set rngTotal = Range("C5:E100")
            'oder diese Zeile,
            'wenn im Blatt die zu bearbeitenden Zellen markiert werden sollen
Set rngTotal = Selection
            'testen im Blatt, mit Schriftart und -grösse > Verhältniszahl =
            
            'Anzahl sichtbare Zeichen / SpaltenBreite (nicht Pixelzahl)
xFactor = 0.9

            'für jede Zelle im Bereich...
For Each xCell In rngTotal
    If Len(xCell.Value) > xCell.Columns.ColumnWidth * xFactor Then
        xCell.Rows.EntireRow.Delete
    End If
Next

Set rngTotal = Nothing

End Sub

Die Zeile "Set rngTotal =............" >>> nur eine der beiden vorgeschlagenen Zeilen aktivieren, je nachdem...

Gruss Urs

 

Nachtrag...

...was heisst wie gross ?
Meinst Du damit die Zellenbreite ?
Aber... wer bestimmt dann, wie gross die Spaltenbreite sein wird ?

Je nachdem, wie Deine Tabelle funktioniert, könnte man den Zellinhalt umbrechen... und dann die Ueberhöhen löschen...

Bedingung >
Im zu bearbeitenden Bereich haben im Normalfall alle Zeilen die gleiche Höhe.
Schriftart und Schriftgrösse spielen keine Rolle.

Funktion >
Im zu bearbeitenden Bereich werden alle Zellen formatiert als "Ausrichtung >>> mit Zeilenumbruch"

>> Jeder Zellinhalt mit "Ueberlänge" wird umgebrochen und die Zeilenhöhe damit vergrössert.
Dieser Code sucht die höheren Zeilen... und entfernt sie >>>

Code:

Sub ExcessHeight()
'funktioniert NUR, wenn alle Zeilen im Bereich ohne Umbruch gleiche Höhe haben
'alle Zellen im entsprechenden Bereich als "mit Zeilenumbruch" formatiert

Dim rngTotal As Range, xRow As Range, xHeight As Double

            'entweder diese Zeile,
            'wenn die zu bearbeitenden Zellen hier festgelegt werden sollen
'Set rngTotal = Range("C5:E100")
            'oder diese Zeile,
            'wenn im Blatt die zu bearbeitenden Zellen markiert werden sollen
Set rngTotal = Selection
            
            'misst die Höhe einer "Normalzelle" auf dem Blatt, hier zB A5
            'plus Toleranz, damit versehentlich nur leicht höhere Zellen
            'nicht auch entfernt werden
xHeight = Cells(5, 1).RowHeight + 4

            'für jede Zeile im Bereich...
For Each xRow In rngTotal.Rows
            'wenn Zeile höher als normal + Toleranz, dann...
    If xRow.RowHeight > xHeight Then
            'entfernt Zeilenumbruch in dieser Zeile, sonst gibts Aerger...
        xRow.EntireRow.WrapText = False
            'entfernt ganze Zeile
        xRow.EntireRow.Delete
    End If
Next

Set rngTotal = Nothing

End Sub

Gruss Urs

 

Hallo Urs2,

danke dir erstmal für deine Vorschläge.

Mit "wie gross" meinte ich Breite und Höhe. Die Inhalt der Zeile darf nich verändert werden, d.h. es darf keine zusätzliche Umbrüche geben. Es muss nur ermittelt werden, ob Zelle sichtbar ist und dann, wenn ja, die Zeile, die diese Zelle enthält, einfach gelöscht werden.
Deine Idee mit Koeffizientberechnung finde ich sehr gut und sie könnte als Grundlage zu den weiteren Überlegungen sein. Aber es gibt wieder das Problem mit unterschiedlichen Zeichen ( habe ich oben schon beschrieben).

Gruß

 

Hi,

vielleicht eine Möglichkeit:

Code:

Sub ZelleZuKlein()
    Dim loZeile As Long
    Dim inSpalte As Integer
    Dim doZeile As Double
    For loZeile = 200 To 1 Step -1
        For inSpalte = 1 To 3
            If Cells(loZeile, inSpalte).WrapText = False Then
                doZeile = Cells(loZeile, inSpalte).Height
                Cells(loZeile, inSpalte).WrapText = True
                If Cells(loZeile, inSpalte).Height > doZeile Then
                    Rows(loZeile).Delete shift:=xlUp
                    Exit For
                End If
                Cells(loZeile, inSpalte).WrapText = False
            End If
        Next inSpalte
    Next loZeile
End Sub

Gerpüft werden die Zeilen 200 bis 1 in den Spalten A bis C.

 

@Karin............. Du hast mich indirekt auf einen Fehler hingewiesen >>>
In einem mehrzeiligen ForEach/Next dürfen keine ganzen Zeilen entfernt werden...
...der Schleifenzähler stolpert, weil ihm aufs mal Zeilen fehlen...


@Lang76
In meiner Variante mit dem xFactor spielen die verschiedenen Buchstabenbreiten keine Rolle.
Ich habe mehrmals die ausschliessende Bedingung erwähnt >
> im zu bearbeitenden Bereich muss eine Nicht-Proporzional-Schrift verwendet werden !
> dann ist der Punkt oder das Leerzeichen immer genau so breit, wie "M" oder "W"

Allerdings hat diese Variante den oben erwähnten ForEach/Next-Fehler noch drin...


Variante mit Zeilenhöhe >
Hier ist ausschliessende Bedingung, dass im Normalfall alle Zeilen im Bereich gleich hoch sind (+ Toleranz).
In den Zellen muss Text stehen, 15-stellige Zahlen im Zahlenformat würden nicht umgebrochen, sondern als #### angezeigt.
In der Tabelle gewählte Schriftart, -grösse und -format... sind hier irrelevant.

Diese Variante habe hier ich angepasst >>>

- mein Fehler mit ForEach/Next ist entfernt

- im Normalfall enthalten die Zeilen im Bereich keine Zeilenumbrüche

- nur für die Bearbeitung durch das Macro wird der Bereich auf "mit Zeilenumbruch" gestellt

- nachher werden die umgebrochene Zeilen entfernt, die nicht umgebrochenen Zeilen werden wieder auf "ohne Zeilenumbruch" gesetzt

Code:

Sub ExcessHeight()
'funktioniert NUR, wenn alle Zeilen im Bereich ohne Umbruch gleiche Höhe haben
'alle Zellen im entsprechenden Bereich sind als "OHNE Zeilenumbruch" formatiert

Dim rngTotal As Range, xHeight As Double, xRowUp As Integer, xRowDown As Integer, i As Integer

            'entweder diese Zeile,
            'wenn die zu bearbeitenden Zellen hier festgelegt werden sollen
'Set rngTotal = Range("C5:E100")
            'oder diese Zeile,
            'wenn im Blatt die zu bearbeitenden Zellen markiert werden sollen
Set rngTotal = Selection
            
            'misst die Höhe einer "Normalzelle" auf dem Blatt, hier zB A5
            'plus Toleranz, damit versehentlich nur leicht höhere Zellen
            'nicht auch entfernt werden
xHeight = Cells(5, 1).RowHeight + 4
            'oberste Zeilennummer im Bereich
xRowUp = rngTotal.Row
            'unterste Zeilennummer
xRowDown = xRowUp + rngTotal.Rows.Count - 1

            'setzt den ganzen Bereich auf "mit Zeilenumbruch"
    rngTotal.Cells.WrapText = True
    
            'für jede Zeile im Bereich, von unten nach oben...
For i = xRowDown To xRowUp Step -1
            'wenn Zeile höher als normal, dann...
    If Rows(i).RowHeight > xHeight Then
            'entfernt zuerst Zeilenumbruch in dieser Zeile, sonst gibts Aerger...
        Rows(i).EntireRow.WrapText = False
            'entfernt ganze Zeile
        Rows(i).EntireRow.Delete
    Else
            'wenn Zeilenhöhe normal > entfernt Zeilenumbruch
        Rows(i).EntireRow.WrapText = False
    End If
Next i

Set rngTotal = Nothing

End Sub

Gruss Urs