Microsoft Excel

Herbers Excel/VBA-Archiv

Daten kopieren und gespiegelt wieder einfügen


Betrifft: Daten kopieren und gespiegelt wieder einfügen
von: Dirk
Geschrieben am: 13.09.2016 19:13:49

Hallo Profis,

brauche mal eure Hilfe.

Ich habe eine Tabelle, in der ich in 4 Spalten untereinander Daten eingebe. Diese Daten werden dann in einer anderen Tabelle (gleicher Aufbau) ausgegeben. Jetzt kommt das Problem: Die Daten in der Zieltabelle sollen nicht genauso wie in der Quelltabelle angeordnet werden, sondern spiegelverkehrt (nicht sortieren); das was also in der Quelltabelle unten steht, soll in der Zieltabelle oben stehen.

Wie kann ich das realisieren?

Danke im Voraus

Gruß
Dirk

  

Betrifft: An welcher Ebene soll gespiegelt wdn, ...
von: Luc:-?
Geschrieben am: 13.09.2016 20:53:23

…Dirk?
Wie du es beschreibst wäre das die horizontale (_⇕_ = oben ↔ unten). Es gäbe noch die vertikale (|⇔| = links ↔ rechts) und die beiden diagonalen, wobei \↙↗\ (links-unten ↔ rechts-oben) der Wirkung der XlFkt MTRANS entspräche, /↖↘/ (rechts-unten ↔ links-oben) aber eine gegenteilige hätte. Das alles wäre mit meiner unveröffentlichten UDF Reflect zu erreichen. Die Veröffentli­chung einer solchen UDF (mit 2 weiteren Optionen, Autor PH) findest du im Tutorial von www.online-excel.de, wahrscheinlich unter der FktsBeschreibung von MTRANS/Transpose. Der ganze QuellBereich müsste dann im HauptArgument der UDF angegeben wdn, die in der ZielTabelle als plurale (mehrzellige) MatrixFml einzutragen wäre. Anschld kann der ZielBereich ja kopiert und mit den Ergebnis­Werten überschrieben wdn.
Gruß, Luc :-?

Besser informiert mit …


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Luschi
Geschrieben am: 13.09.2016 20:58:29

Hallo Dirk,

bei mir sieht das so aus: http://www.herber.de/bbs/user/108151.xlsx

Gruß von Luschi
aus klein-Paris


  

Betrifft: Das geht hier natürlich auch, ...
von: Luc:-?
Geschrieben am: 13.09.2016 21:09:59

…Luschi,
wäre aber nicht anwendbar, wenn zuvor noch mit dem ganzen, derart transponierten Bereich irgendetwas gemacht wdn müsste. U.a. dafür haben dann PH und ich unsere UDFs geschrieben…
Gruß, Luc :-?


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Dirk
Geschrieben am: 14.09.2016 09:32:51

Hallo Luschi,

habe Deinen Anhang ausprobiert. Ist eigentlich das was ich brauche. Folgendes Problem habe ich aber noch. In der Quelldatei stehen die Daten in Spalte A7-H31 (in den Spalten D-H sind jeweils verbundene Zellen). In der Zieltabelle sollen die Daten in den gleichen Spalten stehen. Wenn ich Deine Formel in die Zieltabelle übernehme und meine Bezüge anpasse, bekomme ich nur einen #NV Fehler.

Gruß
Dirk


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Luschi
Geschrieben am: 14.09.2016 12:53:26

Hallo Dirk,

dann stell doch mal ein kleines Musterbeispiel mit Deinen Gegebenheiten bereit.
Aber verbundene Zellen sind eigentlich der Feind jeder Excel-Formel.
In Vba kann man dagegen ganz gut damit umgehen.

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Daniel
Geschrieben am: 14.09.2016 13:05:11

Hi

müsste eigentlich so funktioneren, wenn die Daten nur in umgekehrter Reihenfolge angezeigt werden sollen:

diese Formel muss in die linke obere Zelle der Zieldatei, dann die Formel nach rechts und nach unten ziehen:

=Index(Tabelle1!$A$7:$H$31;26-Zeile(A1);Spalte(B1))
die 26 ergibt sich aus der Anzahl der Zeilen des Zellbereichs (7-31 = 25) + 1
das kannst du auch dynamisch berechnen lassen, dann passt sich die Formel an wenn du Zeilen einfügst oder löschst
=Index(Tabelle1!$A$7:$H$31;Zeilen(Tabelle!$A$7:$H$31)+1-Zeile(A1);Spalte(B1))
Gruß Daniel


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Dirk
Geschrieben am: 14.09.2016 16:17:48

Hallo Daniel,

zuerst einmal ist das schon mal gut. Eines habe ich allerdings vergessen zu erwähnen. Die Quelltabelle ist nicht immer komplett gefüllt. Demanch würden die Inhalte der Zieltabelle am Tabellenende erscheinen. Diese sollen aber dann mit dem letzten Eintrag der Quelltabelle, in der der Zeile der Zieltabelle anfangen. Habe das in einem Beispiel mal abgebildet.

http://www.herber.de/bbs/user/108180.xlsx

Gruß
Dirk


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Daniel
Geschrieben am: 14.09.2016 17:00:15

Hi

dann probier mal das in A2 der Zieltabelle.

=WENN(ZEILE()>(ANZAHL2(Quelltabelle!A:A));"";INDEX(Quelltabelle!A:A;ANZAHL2(Quelltabelle!A:A)-ZEILE() +2)) 
das berücksichtigt jetzt den Füllgrad der der Quelltabelle, wobei diese lückenlos gefüllt sein muss (keine Leerzellen zwischen drin)

Gruß Daniel


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Dirk
Geschrieben am: 17.09.2016 17:14:07

Hallo Daniel,

ich habe Deine Formel intensiv getestet, klappt in der Beispieldatei echt super. Problem, sobald ich eine weitere Tabellenüberschrift einbaue, werden Werte aus der Quelltabelle in der Zieltabelle abgeschnitten. Warum..., keine Ahnung.

Vielleicht hast Du dafür auch noch eine Lösung.

http://www.herber.de/bbs/user/108231.xlsx

Danke im Voraus.

Gruß
Dirk


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Daniel
Geschrieben am: 17.09.2016 22:34:29

Hi
die Formel benötigt zum richtigen Funktionieren die Zeilennummer der letzen befüllten Zeile der Tabelle.
Die Einfache Funktion ANZAHL2 liefert nur dann die den richtigen Wert, wenn in der verwendeten Spalte alle Zellen befüllt sind und keine Leerzellen vorkommen.
Du ermittelst die Anzahl in Spalte D und dort ist die erste Zeile leer.
Bei Zellverbünden ist nur die obere Linke Zelle leer, alle anderen Zellen sind leer.
Wenn die Anzahl der Leerzellen in der Spalte bekannt ist (Überschriftenzeilen), dann kannst du einfach die Anzahl der Leerzellen zum gesamtergebnis hinzuadddieren.
Ist sie nicht bekannt, müsstest du die lezte befüllte Zeile in der Spalte auf einem anderen Weg ermitteln, hier steht wie:
http://www.excelformeln.de/formeln.html?welcher=48

Gruß Daniel


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Dirk
Geschrieben am: 18.09.2016 13:36:14

Hallo Daniel,

ich habe mal die beiden Originaltabellen beigefügt. Wie muss ich die leeren Zellen hinzuaddieren?

http://www.herber.de/bbs/user/108242.xlsm

Danke im Voraus

Gruß
Dirk


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Michael
Geschrieben am: 18.09.2016 19:27:19

Hi,

Excel weigert sich, verbundene Zellen "direkt" zu sortieren, also schreibe ich die Daten erst Mal woanders hin, sortiere sie, und dann kommen sie an die richtige Position:

Sub holenUndSortieren()
Dim maxZ&
Dim a
With Sheets("Quelltabelle")
  maxZ = .Range("C" & .Rows.Count).End(xlUp).Row
  a = .Range("A7:D" & maxZ)
End With

With Sheets("Zieltabelle")
  .Range("K7").Resize(UBound(a), 4) = a
  .Range("K7:N" & maxZ).Sort .Range("M7"), xlDescending
  a = .Range("K7").Resize(UBound(a), 4)
  .Range("K7").Resize(UBound(a), 4).Clear
  .Range("A7").Resize(UBound(a), 4) = a
End With
End Sub
Schöne Grüße,

Michael


  

Betrifft: AW: An welcher Ebene soll gespiegelt wdn, ...
von: Dirk
Geschrieben am: 18.09.2016 20:01:37

Hallo Michael,

ab der Zeile ".Range("K7").Resize(UBound(a), 4) = a" erhalte ich einen Laufzeitfehler 40036.

Gruß
Dirk


  

Betrifft: Datei anbei
von: Michael
Geschrieben am: 19.09.2016 16:32:44

Hi,

den Fehler kann ich (mit xl2013) nicht nachvollziehen.

Hier mal die Datei: http://www.herber.de/bbs/user/108262.xlsm

Schöne Grüße,

Michael


  

Betrifft: Mit der von mir eingangs empfohlenen ...
von: Luc:-?
Geschrieben am: 19.09.2016 19:57:09

…Vorgehensweise hätte eine plurale MatrixFml gereicht, Dirk,
und du hättest außerdem eine nützliche UDF für ZellFml-Einsatz mehr:
G3:J21: {=WENN(ZEILE()-2>ZEILEN(INDIREKT("Quelltabelle!A3:D"&MAX(WENN(C3:C21<>"";ZEILE(C3:C21)))));"";WENN(Reflect(INDIREKT("Quelltabelle!A3:D"&MAX(WENN(C3:C21<>"";ZEILE(C3:C21))));"_")="";"";Reflect(INDIREKT("Quelltabelle!A3:D"&MAX(WENN(C3:C21<>"";ZEILE(C3:C21))));"_")))}
Die Ergebnisse kannst du anschließend kopieren und als Werte über die Fmln oder woandershin speichern (ggf die Leerzellen nochmal löschen) und das Format des Originals übertragen. Für die bisher unver­öffent­lichte UDF Reflect kannst du ja PHs UDF aus dem Online-Excel-Tutorial einsetzen. Findest du wohl im Kapitel zu MTRANS.
Gruß, Luc :-?


  

Betrifft: AW: Mit der von mir eingangs empfohlenen ...
von: Michael
Geschrieben am: 19.09.2016 20:10:22

Hi,

aha, also hier: http://www.online-excel.de/excel/singsel_vba.php?f=91

Gruß,

M.


  

Betrifft: Oha, dann habe ich mich wohl gleich doppelt ...
von: Luc:-?
Geschrieben am: 20.09.2016 01:51:05

…ungenau erinnert, Michael;
Das sind ja SubProzeduren und keine UDFs und außerdem von Nepumuk. Und ich hätte schwören können, eine UDF von PH mit gleich 6 Möglichkeiten gesehen zu haben (auf XLAM.ch ist wohl eine UDF, allerdings nur zum Ersatz von MTRANS). Dann muss ich wohl doch mal Reflect rausrücken (2 kennen sie ja schon):

Public Enum cxMxRefLevel: cxDiagDown: cxDiagUp: cxVert: cxHoriz: End Enum
Public Enum xlTriState: xlTrue = -1: xlFalse: xlCTrue: End Enum

Rem Spiegelt quadrat Matrix an Diagonalen oder AnfangsReihen bzw transponiert
'   nichtquadr Matrix analog; enthält PgmTeile, die nur b.Aufruf aus SubProz,
'   nicht in ZellFmln relevant wdn! Benötigt Enums cxMxRefLevel u.xlTriState!
'   1zl/sp Matrizz wdn in 1dim Vektt gewandelt: hV={1.2.3}, vV={{1};{2};{3}}!
'   Intuitive Symbole f.Arg2 lt Const txRefEb neben cxMxRefLevel=0…3 möglich!
'   Vs1.3 -LSr -cd:20130504 -1pub:20160920 -lupd:20140207n
Function Reflect(ByVal Bezug, Optional ByVal ReflEbene)
    Const txRefEb$ = "d dd du v h q qf qs s w \ \ / | _ d df ds"
    Dim isRange As Boolean, isElVec As xlTriState, refEb As cxMxRefLevel, _
        cn As Long, cx As Long, rn As Long, rx As Long, tmLim(1, 1), _
        avBez, elBez, elVec, tmVecL, tmVecU As Variant
    On Error GoTo fx
    If Not IsMissing(ReflEbene) Then
        If IsNumeric(ReflEbene) Then
            refEb = Abs(ReflEbene) Mod 4
        Else: refEb = WorksheetFunction.Match(ReflEbene, Split(txRefEb), 0) - 1
            If refEb < cxDiagDown Then Err.Raise xlErrNA
            refEb = refEb Mod 5: refEb = refEb + CInt(CBool(refEb))
        End If
    End If
    Let isRange = TypeName(Bezug) = "Range"
    If Not isRange Then
        On Error Resume Next
        tmLim(0, 0) = LBound(Bezug, 1): tmLim(0, 1) = LBound(Bezug, 2)
        tmLim(1, 0) = UBound(Bezug, 1): tmLim(1, 1) = UBound(Bezug, 2)
        tmVecL = Bezug(tmLim(0, 0)): tmVecU = Bezug(tmLim(1, 0))
        On Error GoTo fx
        If IsEmpty(tmLim(0, 1)) Then
            cn = UBound(Bezug) + 1 - LBound(Bezug)
            If IsArray(tmVecL) Or IsArray(tmVecU) Then
                On Error Resume Next
                If IsError(LBound(tmVecL, 2)) And IsError(LBound(tmVecU, 2)) Then
                    On Error GoTo fx: Err.Raise xlErrRef
                ElseIf UBound(tmVecL, 1) <> UBound(tmVecU, 1) Then
                    On Error GoTo fx: Err.Raise xlErrRef
                Else: On Error GoTo fx
                    isElVec = Abs(LBound(tmVecL, 2) = UBound(tmVecL, 2))
                    If isElVec = xlFalse Then Err.Raise xlErrRef
                    rn = UBound(tmVecL, 1) + 1 - LBound(tmVecL, 1)
                End If
            Else: rn = 1
            End If
        ElseIf tmLim(0, 1) = tmLim(1, 1) Then
            rn = tmLim(1, 0) + 1 - tmLim(0, 0)
            If IsArray(tmVecL) Or IsArray(tmVecU) Then
                On Error Resume Next
                If IsError(LBound(tmVecL, 2)) And IsError(LBound(tmVecU, 2)) Then
                    On Error GoTo fx
                    isElVec = CInt(UBound(tmVecL) = UBound(tmVecU))
                    If isElVec = xlFalse Then Err.Raise xlErrRef
                    cn = UBound(tmVecL) + 1 - LBound(tmVecL)
                Else: On Error GoTo fx: Err.Raise xlErrRef
                End If
            Else: cn = 1
            End If
        Else
            If IsArray(Bezug(tmLim(0, 0), tmLim(0, 1))) Or _
                IsArray(Bezug(tmLim(1, 0), tmLim(1, 1))) Then Err.Raise xlErrRef
            cn = tmLim(1, 1) + 1 - tmLim(0, 1): rn = tmLim(1, 0) + 1 - tmLim(0, 0)
        End If
    Else: cn = Bezug.Columns.Count: rn = Bezug.Rows.Count
    End If
    If refEb < cxVert Then ReDim avBez(cn - 1, rn - 1) Else ReDim avBez(rn - 1, cn - 1)
    For Each elBez In Bezug
        If Not isRange Then
            If CBool(isElVec) And IsArray(elBez) Then
                If UBound(elBez) <> Switch(isElVec = xlCTrue, rn, _
                    isElVec = xlTrue, cn) + 1 - LBound(elBez) Then Exit For
            ElseIf CBool(isElVec) Or IsArray(elBez) Then
                Exit For
            End If
        End If
        If CBool(isElVec) Then
            If isElVec = xlTrue Then cx = 0 Else rx = 0
            For Each elVec In elBez
                GoSub mx
                If isElVec = xlTrue Then cx = cx + 1 Else rx = rx + 1
            Next elVec
            If isElVec = xlCTrue Then cx = cx + 1 Else rx = rx + 1
        Else
mx:         Select Case refEb
                Case cxDiagDown: avBez(cx, rx) = elBez
                Case cxDiagUp:   avBez(cn - cx - 1, rn - rx - 1) = elBez
                Case cxVert:     avBez(rx, cn - cx - 1) = elBez
                Case cxHoriz:    avBez(rn - rx - 1, cx) = elBez
            End Select
            If CBool(isElVec) Then Return
            If isRange Then
                cx = (cx + 1) Mod cn: rx = rx - CInt(cx = 0)
            Else: rx = (rx + 1) Mod rn: cx = cx - CInt(rx = 0)
            End If
        End If
    Next elBez
    If IsEmpty(elBez) Then Reflect = avBez Else Err.Raise xlErrRef
    On Error Resume Next
    If IsError(LBound(avBez, 2)) Then
        Err.Number = 0
    Else: On Error GoTo fx: cx = 0: rx = 0
        If UBound(avBez, 1) = 0 And UBound(avBez, 2) > 0 Then
            ReDim avBez(UBound(avBez, 2) - LBound(avBez, 2))
            For Each elBez In Reflect
                avBez(cx) = elBez: cx = cx + 1
            Next elBez
        ElseIf UBound(avBez, 1) > 0 And UBound(avBez, 2) = 0 Then
            ReDim avBez(UBound(avBez, 1) - LBound(avBez, 1)), elVec(0)
            For Each elBez In Reflect
                elVec(0) = elBez: avBez(rx) = elVec: rx = rx + 1
            Next elBez
        End If
        Reflect = avBez
    End If
fx: If CBool(Err.Number) Then
        Select Case Err.Number
        Case Is < xlErrNull: Reflect = CVErr(xlErrNull)
        Case Is > xlErrNA:   Reflect = CVErr(xlErrNA)
        Case Else:           Reflect = CVErr(Err.Number)
        End Select
    End If
End Function
Hätte ich auch noch die beiden anderen Möglichkeiten (mit gleichem Ergebnis → völlige Umkehr der Matrix) einbauen wollen, hätten sie die Intuitiv-Symbole + bzw ×. Aber das hielt ich für überflüssig, da man dann auch 2× Reflect anwenden kann.
Gruß, Luc :-?


  

Betrifft: Ergänzung: Es gibt nicht 2, sondern 6 ...
von: Luc:-?
Geschrieben am: 20.09.2016 22:25:20

…Kombinationsmöglichkeiten, von denen immer 2 das gleiche Ergebnis haben. Das war auch ein Grund, das nicht mit in die UDF einzubauen.
Die Diagonalen als Spiegelebenen gelten streng genommen nur für quadratische Matrizen. Im Falle von anderen rechteckigen Matrizen ist der Bezugspkt für cxDiagDown=0 der linke oberste und für cxDiagUp=1 der rechte unterste Eckwert.
Luc :-?