Daten innerhalb einer Zeile um 180 Grad drehen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub drehen() Dim vntValues As Variant, vntNew() As Variant Dim lngIndex As Long If Selection.Rows.Count = 1 Then If Selection.Columns.Count > 1 Then vntValues = Selection Redim vntNew(1 To 1, 1 To UBound(vntValues, 2)) For lngIndex = UBound(vntValues, 2) To 1 Step -1 vntNew(1, UBound(vntValues, 2) - lngIndex + 1) = vntValues(1, lngIndex) Next Selection = vntNew End If Else MsgBox "Es darf nur eine Zeile markiert werden!", vbInformation End If End Sub

Hallo nochmal,
hier der Code mit den X in Spalte 1.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub drehen()
  Dim vntValues As Variant, vntNew() As Variant
  Dim lngIndex As Long
  If Selection.Rows.Count = 1 Then
    If Selection.Columns.Count > 1 Then
      If Cells(Selection.Row, 1) = "x" Then
        Cells(Selection.Row, 1) = ""
      Else
        Cells(Selection.Row, 1) = "x"
      End If
      vntValues = Selection
      Redim vntNew(1 To 1, 1 To UBound(vntValues, 2))
      For lngIndex = UBound(vntValues, 2) To 1 Step -1
        vntNew(1, UBound(vntValues, 2) - lngIndex + 1) = vntValues(1, lngIndex)
      Next
      Selection = vntNew
    End If
  Else
    MsgBox "Es darf nur eine Zeile markiert werden!", vbInformation
  End If
End Sub

« Gruß Sepp »

Sub andersrum() Dim i As Long Dim b As Long Dim a() a = Application.Transpose(Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, Cells( _ ActiveCell.Row, Columns.Count).End(xlToLeft).Column))) b = UBound(a) For i = LBound(a) To UBound(a) Cells(ActiveCell.Row, b + 1) = a(i, 1) b = b - 1 Next If Cells(ActiveCell.Row, 1) = "" Then Cells(ActiveCell.Row, 1) = "x" Else Cells(ActiveCell.Row, 1) = "" End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim myArray() Dim i As Long, n As Long On Error GoTo ErrH If Target.Column = 1 Then If Not LCase(Target) = "x" And Target "" Then Exit Sub Application.EnableEvents = False ReDim myArray(1 To Cells(Target.Row, Columns.Count).End(xlToLeft).Column) For i = UBound(myArray) To 2 Step -1 n = n + 1 myArray(n) = Cells(Target.Row, i) Next Range(Target.Address).Offset(0, 1).Resize(1, n) = myArray End If ErrH: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Daten innerhalb einer Zeile um 180 Grad drehen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten innerhalb einer Zeile um 180 Grad drehen

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread