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

Spalte fortlaufend beschriften

Spalte fortlaufend beschriften
24.04.2006 15:44:43
Franz
Hallo ihr Profis,
ich habe momentan eine Tabelle mit vielen Spalten, die verschiedene Namen haben. Nun sollen alle Spaltennamen bis zu der letzten Zelle im Spaltenkopf mit Inhalt auf die 1. freie Zelle im Spaltenkopf kopiert werden und dabei soll den Namen eine Ziffer angefügt werden, das wiederholt sich 20mal und dabei soll nach jedem Durchgang die Ziffer hinter dem Spaltennamen um 1 hochgezählt werden.
https://www.herber.de/bbs/user/33068.xls
... Vielen lieben Dank

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte fortlaufend beschriften
24.04.2006 16:13:24
Peter
Hallo Franz,
so sollte es gehen:
Public

Sub Beschriften()
Dim iSpalte  As Integer
Dim ilfdNr   As Integer: ilfdNr = 1
For iSpalte = 4 To 60 Step 3
Cells(1, iSpalte + 0).Value = Cells(1, 1).Value & ilfdNr
Cells(1, iSpalte + 1).Value = Cells(1, 2).Value & ilfdNr
Cells(1, iSpalte + 2).Value = Cells(1, 3).Value & ilfdNr
ilfdNr = ilfdNr + 1
Next iSpalte
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
AW: Spalte fortlaufend beschriften
24.04.2006 16:18:06
ingoG
Hallo Franz,
versuchs mal so:
nachstehendes macro in ein VBA-Modul kopieren und aus dem gewünschten Excelblatt starten
bei mir funzt es so.
Gruß Ingo
PS eine Rückmeldung wäre nett...
Option Explicit

Sub spk_kopieren()
Dim sp_arr() As String
Dim max_col As Integer, ii As Integer, jj As Integer
Dim ct As Integer
On Error GoTo errorh
ct = InputBox("Bitte Anzahl Wiederholungen eingeben", "Eingabe", 1)
max_col = ActiveSheet.Range("iv1").End(xlToLeft).Column
If max_col * ct > 255 Or max_col * ct < 0 Then GoTo errorh
For ii = 1 To max_col
ReDim Preserve sp_arr(ii)
sp_arr(ii) = ActiveSheet.Cells(1, ii)
Next ii
For jj = 1 To ct
For ii = 1 To max_col
ActiveSheet.Cells(1, ii + jj * max_col) = sp_arr(ii) & jj
Next ii
Next jj
Exit Sub
errorh:
MsgBox "Fehlerhafte Eingabe" & Chr(10) & "Programm abgebrochen"
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige