Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1520to1524
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
Inhaltsverzeichnis

Spalten in Matrix verschieben

Spalten in Matrix verschieben
04.11.2016 16:24:30
Anton
Guten Tag zusammen,
Ich habe eine Tabelle welche durch VBA in eine 11 x 11 Matrix eingelesen wird. Nun möchte ich Spalten verschieben. In meinem Beispiel soll nun also Spalte 6 an die Stelle von Spalte 2 geschoben werden. Dafür müssen alle Spalten von 2-5 um einen Platz nach recht verschoben werden. Anschliessend wird Spalte 6 in die nun freigewordene Spalte 2 eingefügt. Hier der dazu von mir geschriebene Code... Leider funktioniert das schieben nicht und ich verstehe überhaupt nicht wieso. Ich würde mich über eure Hilfe sehr freuen!
LG ANTON

Sub InitialPopulation()
Dim rnd_nach As Integer
Dim rnd_von As Integer
rnd_nach = 2
rnd_von = 6
Dim vek_von(1 To 11, 1 To 1)
Dim OSM(1 To 11, 1 To 11)
Range("AF7:AO17").Interior.Color = RGB(255, 255, 255)
Range("AF7:AO17").Value = ""
' OSM DATEN SPEICHERN
For j = 1 To 11
For u = 1 To 11
OSM(u, j) = Range("T7:AD17").Cells(u, j).Value
Next u
Next j
' Ausgewählte Spalte zwischenspeichern
For i = 1 To 11
vek_von(i, 1) = Range("T7:AD17").Cells(i, rnd_von).Value
Next i
' Spalten verschieben
If rnd_von > rnd_nach Then
For p = 11 To 1
If p  rnd_nach Then
For k = 1 To 11
OSM(k, p) = OSM(k, p - 1)
Next k
End If
Next p
End If
'If rnd_von = rnd_von And q 

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten in Matrix verschieben
04.11.2016 17:22:20
Sepp
Hallo Anton,
das Verschieben geht z. B. so.
Sub moveColumns()
Dim rng As Range
Dim vntValues As Variant, vntTmp As Variant
Dim lngR As Long

Const clngMoveFrom As Long = 6
Const clngMoveTo As Long = 2

Set rng = Sheets("Tabelle1").Range("D7:N17") 'Bereich mit der Matrix

vntValues = rng

If clngMoveFrom <> clngMoveTo Then
  If (clngMoveFrom <= UBound(vntValues, 2) And clngMoveFrom >= LBound(vntValues, 2)) And _
    (clngMoveTo >= LBound(vntValues, 2) And clngMoveTo <= UBound(vntValues, 2)) Then
    For lngR = 1 To UBound(vntValues, 1)
      vntTmp = vntValues(lngR, clngMoveTo)
      vntValues(lngR, clngMoveTo) = vntValues(lngR, clngMoveFrom)
      vntValues(lngR, clngMoveFrom) = vntTmp
    Next
    rng = vntValues
  End If
End If

Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Spalten in Matrix verschieben
04.11.2016 17:32:17
snb

Sub M_snb()
Range("T7:AD17").offset(20)=application.index(Range("T7:AD17").value,[row(1:11)],array(1,6,2, _
3,4,5,7,8,9,10,11))
End Sub

Du machst mich fertig! Grüße, owT
04.11.2016 18:12:39
Michael
@snb: Frage zur Formulierung
09.11.2016 19:53:40
Michael
Hi snb,
ich habe mal genau hingesehen, bekomme den Ausdruck [row(1:11)] aber nicht "kompakt" dynamisch notiert, so á la z0=1, z1=11: [row(z0:z1)].
So geht's dann schon: Evaluate("=row(" & z0 & ":" & z1 & ")"), aber auch kürzer?
Schöne Grüße,
Michael
AW: Spalten in Matrix verschieben
04.11.2016 17:31:11
Michael
Hi,
versuche mal:
Option Explicit
Sub InitialPopulation()
Dim a, c ' as Variant, nimmt automatisch die zugewiesene Größe an
Dim i&, j&
Dim aWoher, aWohin ' as Variant, nimmt automatisch die zugewiesene Größe an
Const Woher = "1,1,2,4,6,1,7,5" ' paarweise je Spalte Nr./Anzahl Spalten
Const Wohin = "1,1,3,4,2,1,7,5" ' paarweise je Spalte Nr./Anzahl Spalten
Const vonZ = "T7", nachZ = "AF7", h = 11, b = 11
Range(nachZ).Resize(h, b).Interior.Color = RGB(255, 255, 255)
' Range("AF7:AO17").Value = "" wird eh überschrieben
aWoher = Split(Woher, ",")
aWohin = Split(Wohin, ",")
For i = 0 To 6 Step 2
a = Range(vonZ).Offset(, aWoher(i) - 1).Resize(h, aWoher(i + 1)).Value
Range(nachZ).Offset(, aWohin(i) - 1).Resize(h, aWohin(i + 1)).Value = a
Next
a = Range(vonZ).Resize(h, b)
c = Range(nachZ).Resize(h, b)
For i = 1 To 11
For j = 1 To 11
If a(i, j) = c(i, j) Then
Range("AF7:AP18").Cells(i, j).Interior.Color = RGB(50, 255, 50)
End If
Next
Next
End Sub
Schöne Grüße,
Michael
Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige