Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Transponieren
#1
Hallo

ich möchte Zellen mit einen bestimmten Text Transponieren. Mit der ganzen Zeile oder einzelnen Zellen klappt es. Es sind aber (schon sortiert) mehrere Zellen mit gleichen Inhalt. Wie kann ich die nebeneinder liegenden Zellen zum Transponieren markieren ?

Für einen Tip schon mal Danke
---------------------------------------------------------------------
Code:
Sub Makro2()
Dim zeLLe As Range, Bereich As Range

    Cells.Find(What:="ab", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveCell.Offset(0, -21).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

   Cells.Find(What:="yz", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveCell.Offset(0, -21).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
End Sub

Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
 photo Raute_zps3ee56209.jpg
?mage
to top
#2
Hallo,

stell bitte eine Beispieltabelle ein.
Man sollte vorher und nachher ersehen können.
Gruß Atilla

Excel 2007
to top
#3
Hallo,

die Zellen mit gleichen Inhalt sollen transponiert werden.
Tabelle1

ABCDEFGHIJKLMN
1
2abyzabababyzyzyzyz
3abyz
4abyz
5yz
6
7vorher
8
9
10Wunsch
11

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
to top
#4
Hallo,

leider sind das zu dürftige Angaben. Ich gehe auch davon aus, dass Die Daten bei Dir an anderer Stelle stehen. Da Du im Code mit Activecell arbeitest, kann auch aus dem Code heraus nicht abgeleitet werden, wo sie stehen und wo sie hinkopiert werden sollen.

Deswegen habe ich Deinen Code genommen und ohne jede Fehlerabfragen die Fundstellen in A1 und C1 transponiert.

Code:
Option Explicit

Sub Makro2()
   Dim zeLLe As Range, Bereich As Range
   Dim Anzahl As Long
   Set zeLLe = Cells.Find(What:="ab", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   Anzahl = Application.CountIf(Rows(zeLLe.Row), zeLLe) - 1
   Set Bereich = Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl))
    Bereich.Copy
    Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

   Set zeLLe = Cells.Find(What:="yz", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   Anzahl = Application.CountIf(Rows(zeLLe.Row), zeLLe) - 1
   Set Bereich = Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl))
   Bereich.Copy
   Range("C1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=True
End Sub
Gruß Atilla

Excel 2007
to top
#5
Hallo Atilla,

genau, das ist die Lösung. Vielen Dank.
to top
#6
Hallo Atilla,

leider war meine Freude zu früh. Wenn ich F2 aktiviere und dann Makro ausführe alles ok.
Wenn ich F7 aktiviere und Makro ausführe dann werden die Zellen mit ("ab")aus Zeile 7 richtig übernommen,
aber auch die Zellen aus Zeile 2 (yz). Es soll nur die Zeile welche aktiviert ist bearbeitet werden.

Tabelle1

ABCDEFGHIJKLMNO
1ABCDEFGHIJKLMN
21
32abyzabababyzyzyzyz
43abyz
54abyz
65yz
76
87ababvorher
98
109
1110Wunsch
1211

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
to top
#7
Hi,

(05.01.2015, 20:16)sundw1 schrieb: Es soll nur die Zeile welche aktiviert ist bearbeitet werden.

für eine korrekte Lösung ist es vorteilhaft, die Aufgabe gleich am Anfang komplett zu stellen.
Gruß Ralf

?mage

Die deutsche Rechtschreibung ist Freeware, d.h. du kannst sie kostenlos nutzen.
Allerdings ist sie nicht Open Source, deswegen darfst du sie nicht verändern oder in veränderter Form veröffentlichen.
to top
#8
Hallo,

ich hatte mich schon gewundert, dass da keine Fortsetzung kommt.
Und es gibt immer nur "ab" und "yz" in der Zeile?
Kommen immer beide Suchbegriffe vor oder kann eines oder keins vorhanden sein?

Mit den dürftigen Angaben kann man leider nur eine dürftige Lösung vorschlagen.
Unten der Code hat jetzt einige Einschränkungen.
Es wird immer ab Spalte 6 in der aktiven Zeile nach den zwei benannten Werten gesucht.
Bei Fund wird der Erste in Spalte A ab der aktiven Zeile und der Zweite in C ab der aktiven Zeile transponiert.

Code:
Sub Makro2()
   Dim lngZ As Long, lngs As Long
   lngZ = ActiveCell.Row
   lngs = 6
   Dim zeLLe As Range, Bereich As Range
   Dim Anzahl As Long
   Set zeLLe = Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)).Find(What:="ab", After:=Range("F" & lngs), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   If Not zeLLe Is Nothing Then
      Anzahl = Application.CountIf(Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)), zeLLe) - 1
      Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl)).Copy
       Range("A" & lngZ).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
           False, Transpose:=True
          
   End If
  
   Set zeLLe = Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)).Find(What:="yz", After:=Range("F" & lngs), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   If Not zeLLe Is Nothing Then
      Anzahl = Application.CountIf(Range(Cells(lngZ, lngs), Cells(lngs, Columns.Count)), zeLLe) - 1
      Range(Cells(zeLLe.Row, zeLLe.Column), Cells(zeLLe.Row, zeLLe.Column + Anzahl)).Copy
       Range("C" & lngZ).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
           False, Transpose:=True
      Set zeLLe = Nothing
   End If
End Sub

So einen Code kann man dann z.B mit Doppelklick in eine Zelle starten.

Den obigen Code und folgenden einfach in das Code Modul der Tabelle einfügen:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Call Makro2
   Cancel = True
End Sub
Gruß Atilla

Excel 2007
to top
#9
Hallo Atilla,

da kommt ein alter Mann aus dem Staunen nicht mehr raus.

Vielen Dank, jetzt klappt es
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  transponieren, löschen per vba Dude85 5 343 02.08.2016, 13:33
Letzter Beitrag: Dude85
  Vom Senkrechte ins Waagerechte (kein Transponieren) FerdinandSchuster 18 592 01.08.2016, 12:29
Letzter Beitrag: radagast
  Zellen Transponieren Nukleus 6 372 15.06.2016, 18:51
Letzter Beitrag: Jockel
  Tabelle; Spalten/Zeilen ändern - aber nicht transponieren b-trilogie 5 568 29.03.2016, 12:06
Letzter Beitrag: snb
  Transponieren und Teilen? anana 4 403 10.12.2015, 15:43
Letzter Beitrag: anana
  Zeilen in Spalten transponieren per Formel Dude85 3 988 28.07.2015, 08:34
Letzter Beitrag: Dude85
  weiterziehen/transponieren einer Formel twobbelix 20 3.180 08.07.2015, 09:13
Letzter Beitrag: Rabe
  Recordset in Array dann transponieren Schmittklaus 2 703 29.01.2015, 12:36
Letzter Beitrag: Rabe
  Tabelle transponieren und Bezüge berücksichtigen veve 20 3.307 09.09.2014, 07:45
Letzter Beitrag: veve
  Transponieren bzw. Werte in Nebenzelle ersetzen superkot1 9 1.862 03.09.2014, 21:44
Letzter Beitrag: Rabe

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste