Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1764to1768
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Abschneiden von Texten verhindern

Abschneiden von Texten verhindern
17.06.2020 10:29:19
Texten
Hallo,
ich habe eine Tabelle, gefüllt mit Formeln, die entweder einen Text ausgeben, oder entsprechende Zelle leer lassen ("").
Mein Problem ist, dass die Zellen aufgrund der Darstellung (Kalender) relativ klein sind. Der einzutragende Text ist zu groß für das Textfeld und wird deswegen leider durch die rechts benachbarte Zelle "abgeschnitten", bzw. nicht dargestellt, weil die benachbarte Zelle eben nicht leer ist, sondern eine Formel enthält.
Ich suche nach einer Möglichkeit, den ausgegeben Text über die rechts benachbarten Zellen drüberzuschreiben, ohne dass
- ich dort die Formel herausnehmen muss
- ich die Zellgröße anpassen muss
- ein Zeilenumbruch nötig wird
Da ich nach erster Recherche schon befürchte, dass so ein Textüberlauf nicht möglich sein wird,
freue ich mich auch sehr über eine VBA Lösung, die nur die entsprechenden Zellen mit Text füllt und die übrigen leer lassen würde. Dadurch würde o.g. Problem wohl garnicht erst auftreten.
Leider reichen meine VBA-Kenntnisse hierfür nicht aus.
Ich bin dankbar für jede Hilfe!
Marcel
_______________________________
Anhang: https://www.herber.de/bbs/user/138358.xlsx
- Ausführlicheres Beispiel in Blatt 1
- Minimal-Beispiel in Blatt 2

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 10:50:12
Texten
Hallo Marcel,
gehe auf Zellen formatieren... und anschließend im Dialogfenster auf den Reiter Ausrichtung. Setze im Abschnitt Textsteuerung einen Haken bei An Zellgröße anpassen.
Viele Grüße
Martin
AW: Abschneiden von Texten verhindern
17.06.2020 15:10:43
Texten
Danke für deine Antwort, Martin.
Leider ändert sich dadurch nur die Schriftgröße und der Text wird unlesbar klein.
Text der Zellgrösse anpassen! (owT)
17.06.2020 10:50:29
EtoPHG

AW: Text der Zellgrösse anpassen! (owT)
17.06.2020 15:14:17
Marcel
Dadurch wird die Schrift leider unlesbar klein
AW: Abschneiden von Texten verhindern
17.06.2020 11:09:46
Texten
Hallo Marcel,
falls Du eine VBA-Lösung suchst, teste mal folgendes Makro:
Ich denke, das Anpassen an die Zellgröße bringt Dich nicht weiter. Die Texte könnten zu klein werden.
Option Explicit
Sub FuelleAus()
 Dim rZelle As Range
 Dim sBereich As String
 Dim WSh As Worksheet
 
 sBereich = "$G$13:$AZ$15"      'Hier den Bereich festlegen
 
 With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
 End With
 
 Set WSh = Sheets("Tabelle1")
 For Each rZelle In WSh.Range(sBereich)
  
   With rZelle
     If (WSh.Cells(WSh.Range(sBereich).Row - 1, .Column).Value - 1) _
      = (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
         rZelle.Value = WSh.Cells(.Row, "B").Value
     Else
         rZelle.Value = ""
     End If
   End With
 
 Next rZelle
 With Application
   .ScreenUpdating = True
   .Calculation = xlCalculationAutomatic
 End With
 
End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 15:30:47
Texten
Karl-Heinz,
vielen Dank für deine Lösung! Es funktioniert exakt wie gewollt = )
Für größere Bereich braucht dieses Makro "relativ lange", um den Bereich zu aktualisieren, was bei häufigen Änderungen stören könnte.
Es wäre super, wenn nach dem Editieren einer Zelle, das Makro automatisch für nur diese Zeile ausgeführt wird, um die Rechenzeit zu verkürzen.
Hierzu müsste man den Bereich wohl anpassen auf soetwas wie ActiveCell.Row()?
AW: Abschneiden von Texten verhindern
17.06.2020 15:39:36
Texten
Den Bereich auf Folgendes zu ändern, hat leider nicht funktioniert:
sBereich = "cell(ActiveCell.Row(),7):cell(ActiveCell.Row(),52)"

Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 16:00:22
Texten
Hi,
Du darfst die Anweisungen ja auch nicht in "" setzen, dann wäre es ja ein Text/String.
Du müsstest es schon so machen:
sBereich = Range(Cells(ActiveCell.Row(), 7), Cells(ActiveCell.Row(), 52)).Address
VG KH
AW: Abschneiden von Texten verhindern
17.06.2020 16:26:59
Texten
Das führt bei mir leider zu einer Fehlermeldung.
Wäre super, wenn du noch einmal über das Macro schauen könntest.
Option Explicit
Sub FuelleAus()
Dim rZelle As Range
Dim sBereich As Range
Dim WSh As Worksheet
sBereich = Range(Cells(ActiveCell.Row(), 7), Cells(ActiveCell.Row(), 52)).Address      'Hier  _
den Bereich festlegen
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set WSh = Sheets("Tabelle1")
For Each rZelle In WSh.Range(sBereich)
With rZelle
If (WSh.Cells(WSh.Range(sBereich).Row - 1, .Column).Value - 1) _
= (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
rZelle.Value = WSh.Cells(.Row, "B").Value
Else
rZelle.Value = ""
End If
End With
Next rZelle
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 16:49:57
Texten
Ok, wenn Du es so lösen möchtest, dann siehe nachfolgenden Code.
Ich hatte die Kopfzeile dynamisch gemacht, das passte jetzt nicht mehr, sie muss ja immer 12 sein.
Und bitte eins bedenken: Der Cursor kann sonst wo stehen, z.B. in Zeile 5. Dann haut er Dir ohne Sicherheitsnetz ohne Nachfrage dort ggf. alles kaputt.
Deshalb schau noch mal meine vorherige Lösung an, die immer dann läuft, wenn Du eine Eingabe im bestimmten Bereich gemacht hast. Allerdings muss dort auch die Kopfzeile angepasst werden.
Sub FuelleAus()
 Dim rZelle As Range
 Dim sBereich As String
 Dim WSh As Worksheet
 With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
 End With
 
 Set WSh = Sheets("Tabelle1")
 sBereich = WSh.Range(WSh.Cells(ActiveCell.Row(), 7), _
            WSh.Cells(ActiveCell.Row(), 52)).Address
 
 For Each rZelle In WSh.Range(sBereich)
  
   With rZelle
     If (WSh.Cells(12, .Column).Value - 1) _
      = (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
         rZelle.Value = WSh.Cells(.Row, "B").Value
     Else
         rZelle.Value = ""
     End If
   End With
 
 Next rZelle
 With Application
   .ScreenUpdating = True
   .Calculation = xlCalculationAutomatic
 End With
 
End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 16:55:55
Texten
HI hier noch die angepasste, vorherige Lösung noch mal.
Such Dir was aus.
Sub FuelleAus(Target As Range)
 Dim rZelle As Range
 Dim sBereich As String
 Dim WSh As Worksheet
 
 sBereich = "$G$" & Target.Row & ":$AZ$" & Target.Row      'Hier den Bereich festlegen
 
 With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
 End With
 
 Set WSh = Sheets("Tabelle1")
 For Each rZelle In WSh.Range(sBereich)
  
   With rZelle
     If (WSh.Cells(12, .Column).Value - 1) _
      = (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
         rZelle.Value = WSh.Cells(.Row, "B").Value
     Else
         rZelle.Value = ""
     End If
   End With
 
 Next rZelle
 With Application
   .ScreenUpdating = True
   .Calculation = xlCalculationAutomatic
 End With
 
End Sub
'Dieser Teil ins Tabellenmodul
Private Sub Worksheet_Change(ByVal Target As Range)
 
 With Target
  If .Row > 12 And .Column > 1 And .Column < 6 Then
     If .Value <> "" Then Call FuelleAus(Target)
  End If
 End With
End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Anzeige
AW: Abschneiden von Texten verhindern
17.06.2020 17:03:25
Texten
Ich danke dir vielmals, Karl-Heinz!
AW: Abschneiden von Texten verhindern
17.06.2020 15:51:05
Texten
Hallo Marcel,
danke für die Rückmeldung.
Natürlich können wir gerne noch an der Geschwindigkeit drehen. Schau mal, ob der u.a. Code schon besser ist.
Ich weiß allerdings nicht, was relativ lange heißen soll und wie/wo Du das Starten des Makros eingebaut hast.
Bei mir dauert die Aktualisierung der drei Zeilen exact 0.8 Sekunden.....
Option Explicit
Sub FuelleAus(Target As Range)
 Dim rZelle As Range
 Dim sBereich As String
 Dim WSh As Worksheet
 
 sBereich = "$G$" & Target.Row & ":$AZ$" & Target.Row      'Hier den Bereich festlegen
 
 With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
 End With
 
 Set WSh = Sheets("Tabelle1")
 For Each rZelle In WSh.Range(sBereich)
  
   With rZelle
     If (WSh.Cells(WSh.Range(sBereich).Row - 1, .Column).Value - 1) _
      = (WSh.Cells(.Row, "D").Value - Cells(.Row, "C").Value) Then
         rZelle.Value = WSh.Cells(.Row, "B").Value
     Else
         rZelle.Value = ""
     End If
   End With
 
 Next rZelle
 With Application
   .ScreenUpdating = True
   .Calculation = xlCalculationAutomatic
 End With
 
End Sub
'Dieser Teil ins Tabellenmodul
Private Sub Worksheet_Change(ByVal Target As Range)
 
 With Target
  If .Row > 12 And .Column > 1 And .Column < 6 Then
     If .Value <> "" Then Call FuelleAus(Target)
  End If
 End With
End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Anzeige
Lege ein unsichtbares Textfeld darüber, ...
17.06.2020 13:48:31
Luc:?
…Marcel,
das mit der Zelle verlinkt ist und bei Klick auf diese sichtbar wird. Alternativ könnte die Zelle auch einen Hyperlink (HL) auf sich selbst enthalten, wobei ihr sichtbar sein sollender Inhalt oder ein Symbol angezeigt wird und der wesentliche TextInhalt im HL-InfoText steht, der bei MauszeigerBerührung angezeigt wird.
Gruß, Luc :-?
„Die Intelligenzmenge ist auf diesem Planeten eine Konstante, die Bevölkerung nimmt aber zu!“ Auch deshalb informieren mit …
Anzeige
AW: Lege ein unsichtbares Textfeld darüber, ...
17.06.2020 15:13:07
Marcel
Danke für deine Antwort, Luc.
Um ehrlich zu sein, verstehe ich deine Antwort allerdings nicht. Kannst du mir hierzu eine Beispieltabelle hochladen?
Falls du noch Interesse hast, ...
17.06.2020 23:47:34
Luc:?
…Marcel,
mitteilen und dann AW demnächst.
Luc :-?
AW: Abschneiden von Texten verhindern
17.06.2020 15:18:28
Texten
Hi
füge doch einen "Akutalisieren-Button" ein.
dieser sollte folgende Aktionen ausführen:
1. die bisher verwendete Formel in alle Zellen einfügen
2. die Formeln durch ihren Wert ersetzen
3. Zellen, die den Text "" enthalten, in echte Leerzellen umwandeln, damit diese überschrieben werden
also im Prinzip so:
With Range("dein Zellbereich")
.ForumlaR1C1 = "=hier die Formel in R1C1-Schreibweise"
.Formula = .Value
End With
dieser Code müsste dann zum Aktualisieren ausgeführt werden, entweder per Button oder automatisiert über ein geeignetes Event, je nachdem wo die Daten herkommen.
Gruß Daniel
Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige