Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
652to656
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
652to656
652to656
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Macro Zellen verschieben

Macro Zellen verschieben
22.08.2005 10:29:45
taasba
Hallo,
ich habe eine Tabelle in der Adressen in Spalte A untereinander angeordnet sind. Und zwar jeweils mit 4 Zeilen.
Name
PLZ-Ort (D-12345 Musterort)
Bemerkung
Leerzeile
Nun möchte ich gern ein Makro schreiben, dass die Zellen unterhalb des Namens (PLZ-Ort und Bemerkung) nach rechts auf die Höhe des Namens verschiebt und die drei dann entstandenen Leerzeilen unterhalb des Namens löscht.
Hilfreich wäre es natürlich auch noch, wenn die Zelle PLZ-ORT (Format: D-12345 Musterort) in drei verschiedene Zellen aufgeteilt würde.
Für einen Tipp wäre ich sehr dankbar :-)
MfG
Torsten

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Macro Zellen verschieben
22.08.2005 11:11:25
Ramses
Hallo
das habe ich mal für jemand anderen gemacht.
Vielleicht kannst du es brauchen
Option Explicit
Sub Transform_Customer_Table()
    'by Ramses
    'transponiert Kundendaten die in dieser Form vorliegen
    'kdnr
    'KDName
    'KDTel
    'KDInfo
    'In senkrechte Tabelle
    Dim i As Long, n As Long
    Dim Cr1 As Long, Cc1 As Integer, Cr2 As Long, Cc2 As Integer
    Dim RStart As Integer, CStart As Variant, CCleft As Integer
    Dim wks1 As String, wks2 As String
    Cr1 = 65536
    Cc1 = 1
    Cr2 = 2
    Cc2 = 1
    CCright = 256
    wks2 = ""
    wks1 = Application.InputBox("Wählen Sie bitte die 1. Zelle der Daten in Ihrer Tabelle", "Datentabelle wählen", ActiveSheet.Name)
    wks1 = ActiveSheet.Name
    RStart = InputBox("In welcher Zeile beginnen Ihre Daten ?", "Startzeile", 1)
    If IsNull(RStart) Or Not IsNumeric(RStart) Then
        MsgBox ("Zeilenangabe kann nicht verwendet werden." & Chr$(13) & "Makro wird abgebrochen")
        Exit Sub
    End If
    CStart = InputBox("In welcher Spalte beginnen ihre Daten ?" & Chr$(13) & "Bitte nur Spaltenbezeichnung angeben", "Startpalte", "A")
    If CStart = "" Then
        MsgBox ("Spaltenangabe kann nicht verwendet werden." & Chr$(13) & "Makro wird abgebrochen")
        Exit Sub
    End If
    If Not IsNumeric(CStart) Then
        CStart = Int(Range(CStart & "1").Column)
    End If
    If CStart > 255 Then
        MsgBox ("Spaltenangabe kann nicht verwendet werden." & Chr$(13) & "Makro wird abgebrochen")
        Exit Sub
    End If
    If Cells(Cr1, CStart) = "" Then
        Cr1 = Cells(Cr1, CStart).End(xlUp).Row
    End If
    If Cells(RStart, CCright) = "" Then
        CCright = Cells(RStart, CCright).End(xlToLeft).Column
    End If
    'Neue Zieltabelle anlegen
    Worksheets.Add
    wks2 = ActiveSheet.Name
    'Überschriften anlegen
    Worksheets(wks1).Cells(RStart, CStart).Copy Destination:=Worksheets(wks2).Cells(1, 1)
    Worksheets(wks1).Cells(RStart + 1, CStart).Copy Destination:=Worksheets(wks2).Cells(1, 2)
    Worksheets(wks1).Cells(RStart + 2, CStart).Copy Destination:=Worksheets(wks2).Cells(1, 3)
    'Daten transferieren
    For n = Cc1 + 1 To CCright Step 2
        For i = RStart To Cr1 Step 3
            Worksheets(wks1).Cells(i, n).Copy Destination:=Worksheets(wks2).Cells(Cr2, Cc2)
            Worksheets(wks1).Cells(i + 1, n).Copy Destination:=Worksheets(wks2).Cells(Cr2, Cc2 + 1)
            Worksheets(wks1).Cells(i + 2, n).Copy Destination:=Worksheets(wks2).Cells(Cr2, Cc2 + 2)
            Cr2 = Cr2 + 1
        Next i
    Next n
End Sub
Gruss Rainer
Anzeige
AW: Macro Zellen verschieben
22.08.2005 15:36:32
Taasba
Hallo Ramses,
ich habe mal das Script ein wenig vereinfacht. Leider sagt der Debugger mir, dass der Index ausserhalb des gültigen Berichs liegt. Vielleicht kannst Du mir helfen !?

Sub Verschieben()
Dim i As Long, n As Long, m As Long
Dim Anfangzeile As Integer, Endezeile As Integer
Dim wks1 As String, wks2 As String
Anfangzeile = 1
Endezeile = 20000
Anfangsspalte = 1
Endspalte = 4
n = 0
i = 1
'Daten transponieren
Worksheets.Add
wks2 = ActiveSheet.Name
For n = Anfangzeile To Endezeile Step 4
Worksheets(wks1).Cells(1, n).Copy Destination:=Worksheets(wks2).Cells(1, i)
'Worksheets(wks1).Cells(n + 1, 1).Copy Destination:=Worksheets(wks2).Cells(i, 2)
'Worksheets(wks1).Cells(n + 2, 1).Copy Destination:=Worksheets(wks2).Cells(i, 3)
'Worksheets(wks1).Cells(n + 3, 1).Copy Destination:=Worksheets(wks2).Cells(i, 4)
i = i + 1
Next n
End Sub

Sind die Angaben der Zellen eigentlich richtig. Zuerst die Zeile, dann die Spalte oder andersrum ?
Vielleicht kannst Du mir kurz helfen. Danke bis hierhin für Deine Antwort.
MfG
Torsten
Anzeige
AW: Macro Zellen verschieben
22.08.2005 15:44:49
Ramses
Hallo
Du musst WKS1 noch benennen
Set Wks1 = Worksheets("Wo die Daten herkommen")
Gruss Rainer
AW: Macro Zellen verschieben
22.08.2005 16:20:32
Taasba
So habe das Macro nochmal überarbeitet:

Sub Verschieben()
Dim i As Long, n As Long, m As Long
Dim Anfangzeile As Integer, Endezeile As Integer
Dim wks1 As String, wks2 As String
Anfangzeile = 1
Endezeile = 20000
n = 1
i = 1
'Daten transponieren
wks1 = ActiveSheet.Name
Worksheets.Add
wks2 = ActiveSheet.Name
For n = Anfangzeile To Endezeile Step 4
Worksheets(wks1).Cells(1, n).Copy Destination:=Worksheets(wks2).Cells(1, i)
Worksheets(wks1).Cells(n + 1, 1).Copy Destination:=Worksheets(wks2).Cells(i, 2)
Worksheets(wks1).Cells(n + 2, 1).Copy Destination:=Worksheets(wks2).Cells(i, 3)
Worksheets(wks1).Cells(n + 3, 1).Copy Destination:=Worksheets(wks2).Cells(i, 4)
i = i + 1
Next n
End Sub

Ich bin mir trotzdem noch nicht sicher, ob die Angabe der "Cells" richtig ist. Das Macro wird trotzdem noch abgebrochen mit "Laufzeitfehler 1004 Anwendungs- oder objektdefinierter Fehler."
Anzeige
AW: Macro Zellen verschieben
22.08.2005 16:53:25
Ramses
Hallo
Worksheets(wks1).Cells(1, n).Copy Destination:=Worksheets(wks2).Cells(1, i)
Das ist falsch
Überleg doch mal, was in den anderen Zeilen steht
Worksheets(wks1).Cells(n,1).Copy Destination:=Worksheets(wks2).Cells(i, 1)
Und beim nächsten Mal bitte die Zeile markieren WO Excel hängt.
Einfach mal auf "Debuggen" klicken bei der Fehlermeldung
Gruss Raienr
AW: Macro Zellen verschieben
22.08.2005 16:24:23
Taasba
So nun funktioniert das Makro:

Sub Verschieben()
Dim i As Long, n As Long, m As Long
Dim Anfangzeile As Integer, Endezeile As Integer
Dim wks1 As String, wks2 As String
Anfangzeile = 1
Endezeile = 20000
n = 1
i = 1
'Daten transponieren
wks1 = ActiveSheet.Name
Worksheets.Add
wks2 = ActiveSheet.Name
For n = Anfangzeile To Endezeile Step 4
Worksheets(wks1).Cells(n, 1).Copy Destination:=Worksheets(wks2).Cells(i, 1)
Worksheets(wks1).Cells(n + 1, 1).Copy Destination:=Worksheets(wks2).Cells(i, 2)
Worksheets(wks1).Cells(n + 2, 1).Copy Destination:=Worksheets(wks2).Cells(i, 3)
Worksheets(wks1).Cells(n + 3, 1).Copy Destination:=Worksheets(wks2).Cells(i, 4)
i = i + 1
Next n
End Sub

Danke an Ramses :-))))
MfG
Torsten
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige