Forumbeitrag
Excel-Version des Fragestellers:
2016
Erfahrungslevel des Fragestellers:
Excel gut - VBA bescheiden
Tobi_84
23.02.2025 18:29:12
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
Hallo mal wieder,
das mit dem "Select Case" gefällt mir, ich möchte das jetzt auch noch weiter führen, komm aber mal wieder nicht weiter.
Folgende Situation, je nach "Case" möchte ich gern Zellwerte wiederholt befüllen.
Nur leider weiß ich nicht, als was ich "Dim CharBMK As ?, CharSze As ?" deklarieren muss damit es funktioniert.
Oder ich mach etwas anderes falsch.
Gruß Tobias
das mit dem "Select Case" gefällt mir, ich möchte das jetzt auch noch weiter führen, komm aber mal wieder nicht weiter.
Folgende Situation, je nach "Case" möchte ich gern Zellwerte wiederholt befüllen.
Nur leider weiß ich nicht, als was ich "Dim CharBMK As ?, CharSze As ?" deklarieren muss damit es funktioniert.
Oder ich mach etwas anderes falsch.
Gruß Tobias
Dim anzahlGESAMT As Long, Anzahl As Long
Dim cell As Range, adr5 As Range, rws As Range
Dim anzahlGESAMT As Long, Anzahl As Long
' Tabelle auszählen
Set adr5 = Worksheets("EplSheet").Range("G2:G500" & Cells(Rows.Count, 1).End(xlUp).Row)
anzahlGESAMT = Application.WorksheetFunction.CountA(adr5)
With Worksheets("Druck")
For i = 0 To anzahlGESAMT - 1 ' x beliebige Wierderholung in 1er Reihenschritten
' Schildergröße: Druck Spalte H(8) aus EplSheet Spalte K(11) einlesen
.Cells(1 + i, 8).Value = Worksheets("EplSheet").Cells(2 + i, 11).Value
' Dim CharBMK As ?, CharSze As ?
Select Case Cells(anzahlGESAMT, 8).Value
'-------------------
Case Is = "26x52"
CharBMK = Chr(10) _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 8).Value
CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ "3|" _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value
'-------------------
Case Is = "37x52"
CharBMK = Chr(10) _
+ Chr(10) _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 8).Value
CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ "3|" _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value
'-------------------
'etc
Case Else 'wenn keines der anderen zutrifft
CharBMK = Chr(10) _
+ Chr(10) _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 8).Value
CharSze = Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value _
+ Chr(10) _
+ "3|" _
+ Worksheets("EplSheet").Cells(2 + i, 9).Value
End Select
' BMK: Druck Spalte C(3) aus EplSheet Spalte H(8) einlesen
.Cells(1 + i, 3).Value = CharBMK
' Schriftgröße Druck Spalte F(6) aus EplSheet Spalte I(9) einlesen
.Cells(1 + i, 6).Value = CharSze
Next i
'.
'.
End With
End Sub
Als Antwort auf diesen Beitrag
Kuwer
23.02.2025 11:37:48
AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze
Hallo Tobias,
Konstanten sind nicht mehr änderbar, deshalb wieder als "normale" Variable:
Gruß, Uwe
Konstanten sind nicht mehr änderbar, deshalb wieder als "normale" Variable:
Sub TrennenNachXZeichen_2_Kuwer()
Dim a As Long, i As Long
Dim lngCut As Long, lngZ As Long
Dim vWoerter As Variant, vZeile() As Variant
For lngZ = Cells(Rows.Count, 4).End(xlUp).Row To 3 Step -1
vWoerter = Split(Application.Substitute(Cells(lngZ, 4).Value, vbLf, " "), " ")
If UBound(vWoerter) > -1 Then
ReDim vZeile(0)
a = 0
vZeile(0) = vWoerter(0)
Select Case Cells(lngZ, 8).Value
Case Is = "26x52"
lngCut = 13
Case Is = "37x44"
lngCut = 8
Case Is = "26x140"
lngCut = 20
Case Else 'wenn keines der anderen zutrifft
lngCut = 15
End Select
For i = 0 To UBound(vWoerter) - 1
If Len(vZeile(a)) + Len(vWoerter(i + 1)) > lngCut Then
a = a + 1
ReDim Preserve vZeile(a)
vZeile(a) = vWoerter(i + 1)
Else
vZeile(a) = vZeile(a) & " " & vWoerter(i + 1)
End If
Next i
If UBound(vZeile) > 0 Then
Rows(lngZ + 1).Resize(UBound(vZeile)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
vZeile = Application.Transpose(vZeile)
Cells(lngZ, 4).Resize(UBound(vZeile)).Value = vZeile
End If
End If
Next lngZ
End SubGruß, Uwe
Folgenachrichten
- AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze - von Uduuh am 23.02.2025 18:35:24
- AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze - von Tobi_84 am 23.02.2025 19:41:21
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 24.02.2025 06:54:47
- AW: Problem mit Schleife und Select Case - von Kuwer am 24.02.2025 09:49:46
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 24.02.2025 12:18:46
- vielleicht solltest du ... - von Uduuh am 24.02.2025 21:44:08
- AW: vielleicht solltest du ... - von Tobi_84 am 24.02.2025 21:50:41
- AW: vielleicht solltest du ... - von Tobi_84 am 24.02.2025 21:50:41
- AW: Problem mit Schleife und Select Case - von Kuwer am 24.02.2025 22:02:49
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 25.02.2025 06:43:09
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 25.02.2025 06:43:09
- vielleicht solltest du ... - von Uduuh am 24.02.2025 21:44:08
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 24.02.2025 12:18:46
- AW: Problem mit Schleife und Select Case - von Kuwer am 24.02.2025 09:49:46
- AW: Problem mit Schleife und Select Case - von Tobi_84 am 24.02.2025 06:54:47
- AW: Spalte auf Textlänge überprüfen & statt Umbruch, neue Ze - von Tobi_84 am 23.02.2025 19:41:21
Antwort auf Beitrag erstellen