VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 16:40:02

Hundeliebhaber

Hallo zusammen,

ich benötige VBA-Code, um Spaltennamen zu kürzen. Die Spaltennamen stehen in der ersten Zeile, also der Code soll ausschließlich auf die erste Zeile angewendet werden, jedoch erst ab der dritten Spalte bis zur letzten Spalte, die Text hat.

Die Spaltennamen sehen wie folgt aus:

abc_def_ghi_jkl_mno

Dabei kann jeder Teil zwischen den Trennzeichen beliebig lang sein, es gibt jedoch immer diese fünf Bestandteile und diese vier Trennzeichen (Unterstriche).

Nun möchte ich den Teil zwischen den beiden letzten Unterstrichen, also in dem Beispiel jkl, kürzen: Wenn hier mehr als sieben Zeichen stehen, sollen die Zeichen, die über sieben sind, abgeschnitten werden. Sind es weniger als sieben, soll der Text so bleiben.

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 17:39:53

cysu11

Hi,

probiere mal so:

Sub ticut()

Dim myRange As Range, c As Range, lastcol As Long, alt As String, neu As String, Teile As Variant

lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Set myRange = Range(Cells(1, 3), Cells(1, lastcol))

For Each c In myRange

    alt = c.Value

    Teile = Split(alt, "_")

    If UBound(Teile) >= 4 Then

    neu = Left(Teile(3), 7)

    c.Value = neu

    End If

Next c

End Sub

LG, Alexandra

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 19:32:27

Yal

Moin,

inspiriert von den bisherigen Beiträge...

Gezieltes Zusammenbauen auf Basis einer Liste:

Sub ticut()

Dim z As Range

Dim Arr

Dim j

Dim Erg As String



    For Each z In ActiveSheet.Range("C1:XFD1").SpecialCells(xlCellTypeConstants)

        Arr = Split(z.Value, "_")

        For Each j In Arr(0, 1, 2, 4) 'feste Liste ohne Element 3 

            Erg = Erg & "_" & Arr(j)

        Next

        z.Value = Mid(Erg, 2)

    Next

End Sub

Element 3 durch Elt 4 ersetzen, Array kürzen:

Sub ticut()

Dim z As Range

Dim Arr



    For Each z In ActiveSheet.Range("C1:XFD1").SpecialCells(xlCellTypeConstants)

        Arr = Split(z.Value, "_")

        Arr(3) = Arr(4)

        ReDim Preserve Arr(3)

        z.Value = Join(Arr, "_")

    Next

End Sub

noch ein Gedicht:

Sub ticut()

Dim z As Range

Dim Arr



    For Each z In ActiveSheet.Range("C1:XFD1").SpecialCells(xlCellTypeConstants)

        Arr = Split(z.Value, "_")

        Arr(3) = "" 'Alternativ: "||"

        z.Value = Replace(Join(Arr, "_"), "__", "_") 'dementsp.:  .., "_||_", "_")

    Next

End Sub

Version keep it simple:

Sub ticut()

Dim z As Range

Dim A



    For Each z In ActiveSheet.Range("C1:XFD1").SpecialCells(xlCellTypeConstants)

        A = Split(z.Value, "_")

        z.Value = A(0) & "_" & A(1) & "_" & A(2) & "_" & A(4) 

        'Alternative: z.Value = Join(Array(A(0), A(1), A(2), A(4)), "_")

    Next

End Sub

VG
Yal

VBA?

27.03.2025 09:33:39

RPP63

Moin!
Zunächst mal ist exakt ein Beispiel etwas wenig.
Da die Beschreibung für mich aber verständlich war, würde ich auf VBA verzichten und dies mittels Formel regeln.
(man kann die Formel natürlich auch mittels VBA umsetzen)

	C	D
1	abc_def_ghi_jkl_mno	a_ef_gi_jklmnopq_mno
2	abc_def_ghi_jkl_mno	a_ef_gi_jklmnop_mno

Zelle	Formel
C2	=LET(ax;INDEX(TEXTTEILEN(C1;"_");;4);WECHSELN(C1;ax;LINKS(ax;7)))
D2	=LET(ax;INDEX(TEXTTEILEN(D1;"_");;4);WECHSELN(D1;ax;LINKS(ax;7)))

Gruß Ralf

Hier noch eine Version...

27.03.2025 11:08:37

Case

Moin, :-)

... mit REGEXERSETZEN: ;-)
https://www.herber.de/bbs/user/176449.xlsb

Servus
Case

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

27.03.2025 13:10:00

Hundeliebhaber

Vielen Dank an alle, sehr hilf- und lehrreich!

Als...

27.03.2025 12:27:26

Case

Moin, :-)

... VBA Variante: ;-)
https://www.herber.de/bbs/user/176452.xlsb

Servus
Case

ach ne, total daneben...

26.03.2025 19:34:26

Yal

...egal. War mir eh langweilig. :-)

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 18:35:18

BoskoBiati

Hi Alexandra,

das trifft wohl eher nicht das Gewünschte:

Sub ticut()

Dim myRange As Range, c As Range, lastcol As Long, alt As String, neu As String, Teile As Variant

lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Set myRange = Range(Cells(1, 3), Cells(1, lastcol))

For Each c In myRange

    alt = c.Value

    Teile = Split(alt, "_")

    Teile(3) = Left(Teile(3), 7)

    c.Value = Join(Teile, "_")

Next c

End Sub

Gruß

Edgar

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 18:57:43

{Boris}

Hi,

ohne lastCol etc.:

Sub til()

Dim var As Variant, C As Range

For Each C In ActiveSheet.Range("C1:XFD1").SpecialCells(xlCellTypeConstants)

    var = Split(C, "_")

    var(3) = Left(var(3), 7)

    C = Join(var, "_")

Next C

End Sub

VG, Boris

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 19:17:18

cysu11

Hallo Edgar,

ich glaube dein Code trifft nicht das Gewünschte! :)

LG, Alexandra

AW: VBA Spaltennamen zwischen Trennzeichen kürzen

26.03.2025 19:19:13

cysu11

Hallo Edgar,
sorry, jetzt habe ich es auch endlich kapiert! :)
Du hast natürlich Recht!

LG, Alexandra

VBA Spaltennamen zwischen Trennzeichen kürzen

Forumthread: VBA Spaltennamen zwischen Trennzeichen kürzen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

VBA Spaltennamen zwischen Trennzeichen kürzen

Forumthread: VBA Spaltennamen zwischen Trennzeichen kürzen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread