MS-Office-Forum

MS-Office-Forum (https://www.ms-office-forum.net/forum/index.php)
-   Microsoft Excel (https://www.ms-office-forum.net/forum/forumdisplay.php?f=29)
-   -   Werte unter Spalte verteilen (https://www.ms-office-forum.net/forum/showthread.php?t=348726)

Oelis 12.01.2018 17:25

Werte unter Spalte verteilen
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,

ich habe in Zeile2 eine Datumsangabe in jeder Spalte
2018/KW1; 2018/KW2 u.s.w. (Blatt2)

in einem anderen Blatt1 habe ich Werte welche sich wöchentlich verändern.
Diese Werte stehen immer an gleicher stelle.

Beispiel ZelleD5 bis Zelle D30

Nun möchte ich über den Start eines Makros folgendes:
Er soll sich das Datum aus Blatt1 Zelle2 merken und im Blatt 2 an diese Stelle springen wo sich das Datum befindet und dann die Daten von ZelleD5 bis ZelleD30 einfügen.

Wer kann mir hier helfen wie das Makro aussehen kann?

Hajo_Zi 12.01.2018 17:48

Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.

Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

das Makro soll also 25 Zellen in eine Zelle schreiben, mit Trennzeichen?

GrußformelHomepage

Oelis 12.01.2018 18:03

ich habe die tabelle hochgeladen

er soll nun aus Blatt 1 die Werte von Zelle D5:N33 in Blatt 2 die heutige KW aussuchen und dann nach rechts einspielen

Hajo_Zi 12.01.2018 18:07

das geht nicht, da eine XLSX Datei kein Makro enthalten kann.
Ich sehe keinen Grund eine Datei 2x zu speichern. Ich führe keine Liste unter welchem Dateinamen ich die Datei gespeichert habe.

ich bin dann raus, da meine Beiträge nicht komplett gelesen werden.
Das wird schon seinen Grund haben.

Gruß Hajo

Oelis 12.01.2018 18:17

ohje ich habe sie nun als xlsm gespeichert, geht es nun?

WS-53 12.01.2018 18:43

Hallo,

zuerst einmal versteh ich den Sinn nicht so ganz. Du willst das etweas von einem in das andere Tabellenblatt übertragen wird, obwohl die dann beide doch identsiche Werte zeigen?

Und warum benötigst du dazu ein Makro anstatt dies mit einer einfachen Formel zu lösen?

Oelis 12.01.2018 19:12

Hallo,

die Werte sind jede woche neu und sollen dann überschrieben werden.

Das heisst es ist immer nur die aktuelle Woche fix und in der Folgewoche kommen dann neue Zahlen

aloys78 12.01.2018 22:59

Hallo Oelis,

beim Vergleich Deiner Beschreibung mit der Beispieldatei fällt mir auf:
Zitat:

ich habe in Zeile2 eine Datumsangabe in jeder Spalte
Ich sehe die in Zeile 1
Zitat:

in einem anderen Blatt1 habe ich Werte welche sich wöchentlich verändern. Diese Werte stehen immer an gleicher stelle.
Beispiel ZelleD5 bis Zelle D30
Ich sehe diese Werte in D5 bis D33

Ggf kannst Du meinen Lösungsvorschlag ja anpassen.
Code:

Option Explicit

Sub Kopieren()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim c As Long, s As Long
    Dim LCol1 As Long
    Dim LCol2 As Long
    Dim erg As Variant
   
    Set ws1 = Worksheets("Blatt1")
    Set ws2 = Worksheets("Blatt2")
   
    With ws1
        LCol1 = .Cells(2, Columns.Count).End(xlToLeft).Column
        LCol2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
        For c = 4 To LCol1
            erg = Application.Match(.Cells(2, c), ws2.Range(ws2.Cells(1, "B"), ws2.Cells(1, LCol2)), 0)
            If IsNumeric(erg) Then
                s = erg + 1
                ws2.Range(ws2.Cells(2, s), ws2.Cells(31, s)).Copy .Cells(4, c)
            End If
        Next c
    End With
End Sub

Gruß
Aloys

Oelis 13.01.2018 20:43

Hallo, Danke


er soll die Daten von Blatt1 in Blatt 2kopieren. Das macht der komplett anders rum.
Kannst du das ändern?

aloys78 14.01.2018 07:33

Hallo Oelis,
Zitat:

Kannst du das ändern?
Dann probier mal:
Code:

Option Explicit

Sub Kopieren()
    Dim ws1 As Worksheet            ' Blatt 1
    Dim ws2 As Worksheet            ' Blatt 2
    Dim c As Long, c2 As Long      ' Spalten# Blatt 2
    Dim LCol1 As Long              ' letzte Datenspalte in Blatt 1
    Dim LCol2 As Long              ' letzte Datenspalte in Blatt 2
    Dim erg As Variant              ' Ergebnis Match
   
    Set ws1 = Worksheets("Blatt1")
    Set ws2 = Worksheets("Blatt2")
   
    With ws1
        LCol1 = .Cells(2, Columns.Count).End(xlToLeft).Column
        LCol2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
       
' Suche Datum D2 in Zeile 1 von Blatt 2
        erg = Application.Match(.Cells(2, "D"), ws2.Range(ws2.Cells(1, "B"), ws2.Cells(1, LCol2)), 0)
        If IsNumeric(erg) Then
            c = erg + 1                ' Start-Spalte in Blatt 2
           
    ' Zielbereich in Blatt2 löschen
            With ws2
                .Range(.Cells(3, c), .Cells(31, LCol2)).ClearContents
            End With
           
    ' Daten aus Blatt 1 nach Blatt 2 kopieren
            .Range(.Cells(5, "D"), .Cells(33, LCol1)).Copy ws2.Cells(3, c)
            c2 = c + LCol1 - 4
            With ws2
                .Range(.Cells(3, c), .Cells(31, c2)).NumberFormat = "###0"
            End With
        Else
           
    ' Datum in Blatt 2 nicht gefunden
            MsgBox "Datum " & .Range("D2") & " in Blatt 2 nicht gefunden !", vbCritical
            Exit Sub
        End If
    End With
End Sub

Gruß
Aloys


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:04 Uhr.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.