Clever-Excel-Forum

Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Edit: und den Namen in R1834 Smile

Hallo Alex,

O6: P6
da war eine Zeile doppelt statt unterschiedlich ... leicht zu ändern - in der zweiten Zeile müssen die Bereiche entsprechend angepasst werden.

Code:
'A6--B6--O6--P6 (Stehen in der Reihenfolge im "Setup")

'C7--D7--F7--G7 (müssen da starten, da A&B ausgeblendet wurden müssen wir die Daten hier hin verschieben verschieben)

Range("C7:D7")=.Range("A6:B6")

Range("C7:D7")=.Range("A6:B6") '<-- hier auf E7:G7 und O6:Q6 ändern, Q6 war da aber nicht verlangt!?

Hier wolltest Du Daten aus Zeile 15 nach Zeile 16 holen und nicht aus Zeile 16. Ich habe lediglich das Ziel A16:B16 in C16:D16 geändert, A und B werden ja ausgeblendet.
Siehe dazu auch meine Frage im code: Ziel soll bestimmt C16 und D16 sein?

Code:
'A15--B15--N15--O15--P15(Stehen in der Reihenfolge im "Setup")

'A16--B16--N16--O16--P16(müssen da starten, da A&B ausgeblendet wurden müssen wir die Daten hier hin verschieben verschieben)

Range("C16:D16")=.Range("A15:B15")

Range("N16:P16")=.Range("N15:P15")

Wenn die Daten aus Zeile 16 nach Zeile 16 sollen, dann nur die 15er entprechend ändern bzw. für die Daten aus N bis P den folgenden Änderungshinweis berücksichtigen.

Zitat:
Kann man nach der Kopie die Werte:
N16--O16--P16
"vorziehen auf"
E16--F16--G16
Ja klar, dann einfach statt N16:P16 den gewünschten Bereich E16:G16 eingeben.

Format %
Nach dem Einfügen der Daten erweiterst Du den VBA-Code um eine Zeile mit der Formatierung:

Code:
With Sheets("Input")

Range("C7:D7").Value = .Range("A6:B6").Value

Cells(7, 4).NumberFormat = "0.00%"

Datum vertauscht:
das war so verlangt Sad

Code:
'A8--B8--N8 (Stehen in der Reihenfolge im "Setup")

'C9--E9--D9 (müssen da starten, da A&B ausgeblendet wurden müssen wir die Daten hier hin verschieben verschieben)

Cells(9, 3) = .Cells(8, 1) 'Daten aus A8 nach C9 

Cells(9, 5) = .Cells(8, 2) 'Daten aus B8 nach E9  

Cells(9, 4) = .Cells(8, 14) 'Daten aus N8 nach D9

Hier einfach die beiden Spaltennummern 4 und 5 vertauschen ...

Die Namen und Daten hab ich im Code zwei Spalten nach rechts geschoben - hatte nicht gesehen, dass in R schon was stand Sad

Würde S und T gehen? Dann einfach auf die 18 und 19 noch einen dazugeben.

Code:
'In Spalte R (18) bearbeiter und in Spalte S (19) Datum & Zeit eintragen

.Cells(.Cells(Rows.Count, 18).End(xlUp).Row + 1, 18) = Application.UserName

.Cells(.Cells(Rows.Count, 18).End(xlUp).Row, 19) = Date + Time '-- die eine 18 ist korrekt.

Da die Datei vielleicht häufig genutzt wird, brauchen wir zwei leere Spalten. Wenn die 13? Zeilen aus Spalte P und Q der alten Variante reichen, kann ich es auch wieder dort platzieren. Durch die Additional Comments hast Du den Platz dort eingeschränkt.

Menü zum Bereinigen kommt morgen.
Die Eingaben werden in Spalte G und I getätigt, sonst nirgends? Ich würde dann die Spalten - natürlich ausgenommen die Überschriften - leeren.
Das Blatt mit den kopierten Daten bleibt aber und wird bei Bedarf manuell gelöscht?

Hallo Schauan,

danke für Deine Hilfe :) Du wirst es nicht glauben, aber mit deinen Kommentaren hat man dann eine Logik, die man sehen kann und selbst basteln kann :) Das heißt nich, dass du damit raus bist :D

Ich hab den ein oder anderen Bereich (erfolgreich) angepasst.

- Alle angesprochenen Bereiche werden jetzt da angezeigt bzw. übernommen, wo sie sollen
- Format % erfolgreich eingefügt
- Verschobenes von, bis --> mea culpa, sorry :)
- ich hab den Start der zu kopierenden Artikel um zwei Zeilen runter geschoben

To do now:

- Makro so anpassen, dass wenn die Zellen gesperrt sind keine Fehlermeldung mehr erscheint
- application.user und date.time statt auf input S & T umsetzen auf kopiertes blatt H2 & I2 (ich wollte dir arbeit ersparen und das selbst machen aber er fügt die daten ja erst nach dem kopieren ein :)
- nach kopie steht im additional comments in P16 evtl. eine Telefonnummer, die er nach dem Kopieren nicht mehr als telefonnummer darstellt sondern so: 4,9176E+13. Kann man das umwandeln? (bevor sich jemand die Mühe macht, die Nummer gibt es nicht) ;)
-

Bereinigungsmakro:

Kunde kann in "Input" folgendes eingeben (das sind die Zellen, die später wieder inhaltlich leer sein sollen:

B6
P6
B8:N11
B13
B14
A16
B16
N16
O16
P16

Nach Input in den nachfolgenden 13 Tabellenblättern nur I & K
Das 14 Tabellenblatt "Sales" hat nur verkaufsartikel und keine Mietartikel. Dort kann er nur in G eine Anzahl eintippen, die er benötigt.

Danke schauan :)

In % sind wir bei 92 würde ich sagen :) :15 100

Viele Grüße und bis morgen....(was mache ich eigentlich nach diesem Projekt?! Ach ja, wir haben ja noch eins ;) )

Alex

Smilies und Latein-Zitat korrigiert.
Moderator [Bild: smilie.php?smile_ID=1810]

Edit: Lieber Moderator,

vielen Dank für die Korrekturen :19:

Viele Grüße
Alex

Hallo Alex,

anbei die aktuelle Mustertabelle. Allerdings sind da jetzt nicht die Korrekturen von gestern drin und was Du sonst noch geändert hast.

Dazu gleich noch ein Hinweis. Wenn Du einen Texteditor hast wie z.B pspad editor oder notepad++, hast Du darin die Möglichkeit, Dateien zu vergleichen. Du könntest z.B. die Module von Deiner und meiner Version exportieren und dann dort vergleichen. Da siehst Du gleich die Unterschiede anhand der farblichen Markierungen. Beide editoren kann man ohne Installation nutzen.

Geändert habe ich
Sub CellMenueAdd
Sub CellMenueDelete
Die kannst Du komplett ersetzen.

Neu ist
Sub CellReset
Das nimmst Du neu rein.

Im Sub Kopieren hab ich nur die Sache mit dem Namen und Datum geändert, und zwar hier die bisherigen Zeilen durch das Hochkomma auskommentiert und 3 neue Zeilen eingefügt:

Code:
'In Spalte R (18) bearbeiter und in Spalte S (19) Datum & Zeit eintragen

'.Cells(.Cells(Rows.Count, 18).End(xlUp).Row + 1, 18) = Application.UserName

'.Cells(.Cells(Rows.Count, 18).End(xlUp).Row, 19) = Date + Time '-- die eine 18 ist korrekt.

'In H2 Bearbeiter und in I2 Datum & Zeit eintragen

Cells(2, 8) = Application.UserName

Cells(2, 9) = Date + Time

Wann genau erscheint denn die Meldung wegen der gesperrten Zellen? In welcher Codezeile bleibt das Programm eventuell hängen?

Du kannst ja für die nächste Änderung das Modul in Deiner Datei exportieren, zippen und hochladen, oder schickst mir die neueste Version mit den Änderungen von heute..

Hallo Schauan,

vielen Dank, für das sehr gut gelungene Update Smile

Noch heute morgen wollte ich mich dran setzten und mal nach einem Programm suchen, welches Codes miteinander vergleicht aber dann kam mein Arbeitstag dazwischen Smile

Danke, dass du mir zuvor gekommen bist damit. Super Tool!!!:15:

Also, es gibt einen Laufzeitfehler '1004' "Die Hidden-Eigenschaft des Range-Objekts kann nicht festgelegt werden"

Ich habe das "zurück setzen der Mappe" ein wenig verändert.

Jetzt weiß ich, was du mit dem Kommentar meintest, "Beachte: In diesem Beispiel muss das Blatt manuell wieder geloescht werden!". Evtl. ist es eine gute Idee, dass sich die Mappe dann auch mit Löschung der kopierten Datein zurück setzt... würde das gehen?

Freue mich von dir zu hören!

Nochmals herzlichen Dank!!!! :100: :78:

Hallo Alex,

Es gibt eine kleine Schwierigkeit, wenn Du das temporäre Blatt löschen willst. Excel weiß irgendwann nicht mehr ohne weiteres, welches das neue Blatt ist. Es gäbe verschiedene Möglichkeiten, dass man Excel eine "Gedankenstütze" gibt, z.B. über globale Variable - die allerdings nach bestimmten Aktionen wieder leer ist -, oder man speichert den Namen des Tabellenblattes irgendwo.

Ich habe einen anderen Ansatz im Blick :21:
Auf dem temporären Tabellenblatt ist ja ein Bild drauf. In der Hoffnung, dass nicht noch auf anderen Tabellen Bilder drauf sind, würde ich daher alle Blätter löschen, wo eins oder mehrere drauf sind. Die Blätter "Input" und "Sales" sind durch die vorgelagerte Bedingung davon ausgenommen.

Änderungen im Makro Sub cellReset:

Code:
For Each blaetter In Worksheets()

  'Wenn der Blattname nicht Input und Sales ist, dann

  If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then

    'Spalte I und K ab Zeile 3 bereinigen

    blaetter.Range("I3:I1048576").Value = ""

    blaetter.Range("K3:K1048576").Value = ""

    'Blatt loeschen, wenn ein Bild drauf ist            '<-- hier

    If blaetter.Pictures.Count > 0 Then blaetter.Delete '<-- hier

  'Ende Wenn der Blattname nicht Input und Sales ist, dann

  End If

'Ende Schleife ueber alle Blaetter

Next

Hallo Schauan,

warum so früh heute?! Smile

Danke, für diese Idee, die ich ausgesprochen gut finde, da es sonst nirgendswo "Logo" gibt und somit alles gut ist Smile

Wenn wir jetzt die kopierten Daten betrachten, sieht der Kunde noch nicht den Preis in Summe, den er bezahlen muss. Daher die Frage:

wäre es mölich, dass es am Ende jeder Auswahl mit den Überschriften aus den Tabellenblättern eine Summe gibt und am ende des Blattes eine Gesamtsumme?
Also evlt. Zwischensummen und am Schluss der gesamte Betrag?

Ich verstehe nach wie vor nicht, warum er mir das dropdown nur bei mir anzeigt. Ich werde noch völlig verrückt damit Smile

Danke schauan.

Viele Grüße
Alex

Edit: Hallo Schauan,

nach dem "bereinigern" Nimmt er mir in zwei tabellen die "I" und "K" überschrift weg also "needed number" und "Select Timeline" :(

Vielen Dank fürs Checken und viele Grüße
Alex

Hallo Alex,

wenn das Excel-Makro die Überschriften wegnimmt, stehen die eventuell nicht in Zeile 2 ?? Ich bin bisher davon ausgegangen, dass es überall Zeile 2 ist. Dann müsste man für die beiden Tabellenblätter eine Ausnahmeregelung machen - oder Du kannst die Überschriften hochsetzen?

Hier noch der code für die Zwischensummen uns Summe.

'auf einem Blatt zusammenfassen

Code:
'_______________________________________________________

Sub Kopieren()

'Variablendeklarationen

'Objekte

Dim myWsh As Worksheet, tmpWsh As Worksheet, myRng As Range

'String

Dim strAddress As String, strFind As String

'Integer

Dim iCnt%, iPasteRow%, iSumRow%

'single

Dim sSum As Single

'temporäres Blatt hinzufügen. Beachte: In diesem Beispiel muss das Blatt

'manuell wieder geloescht werden!

Set tmpWsh = Worksheets.Add(before:=Sheets(1))

'Daten aus Input uebernehmen

With Sheets("Input")

Range("C7:D7").Value = .Range("A6:B6").Value

Cells(7, 4).NumberFormat = "0.00%"

Range("F7:G7").Value = .Range("O6:P6").Value

Cells(8, 4) = .Cells(7, 2) 'Daten aus B7 nach E8

Cells(8, 5) = .Cells(7, 14) 'Daten aus N7 nach D8

Cells(9, 3) = .Cells(8, 1) 'Daten aus A8 nach C9

Cells(9, 5) = .Cells(8, 2) 'Daten aus B8 nach E9

Range("D9:E9").NumberFormat = "m/d/yyyy" 'Datumsformat setzen

Cells(9, 4) = .Cells(8, 14) 'Daten aus N8 nach D9

Range("C10:D12").Value = .Range("A9:B11").Value

Range("E10:E12").Value = .Range("N9:N11").Value

Range("C14:C15").Value = .Range("A13:A14").Value

Range("C16:D16").Value = .Range("A15:B15").Value

Range("N16:P16").Value = .Range("N15:P15").Value

Range("C17:G17").Value = .Range("C16:G16").Value

Cells(17, 8) = .Cells(17, 7)

'In Spalte R (18) bearbeiter und in Spalte S (19) Datum & Zeit eintragen

'.Cells(.Cells(Rows.Count, 18).End(xlUp).Row + 1, 18) = Application.UserName

'.Cells(.Cells(Rows.Count, 18).End(xlUp).Row, 19) = Date + Time '-- die eine 18 ist korrekt.

'In H2 Bearbeiter und in I2 Datum & Zeit eintragen

Cells(2, 8) = Application.UserName

Cells(2, 9) = Date + Time

'Bild kopieren und im aktiven Blatt in C1 einfuegen

.Shapes("Logo").Copy

ActiveSheet.Paste Range("C1")

'Ende Daten aus Input uebernehmen

End With

'Schleife ueber alle Blaetter

For Each myWsh In Worksheets

  'mit dem Blatt myWsh

  With myWsh

    'Wenn der Blattname vom temporaeren Blatt <> vom Blatt myWsh ist, dann

    If tmpWsh.Name <> myWsh.Name And myWsh.Name <> "Input" Then

        'Ueberschrift 1x kopieren

        'wenn Zelle C18 auf temporaerem Blatt leer ist, dann

        If tmpWsh.Cells(18, 3) = "" Then

          'aus Zeile 2 kopieren

          .Range("A2:M2").Copy

          'in Zeile 18 auf temporaerem Blatt einfuegen, Bereich ggf. anpassen

          tmpWsh.Paste tmpWsh.Range("A18")

        'Ende wenn Zelle C18 leer ist, dann

        End If

        'Wenn die Summe von Spalte G > 0 ist, dann

        If WorksheetFunction.Sum(.Range("G:G")) > 0 Then

            'Spalte A und B einblenden

            .Columns("A:B").EntireColumn.Hidden = False

            'Autofilter in Spalte G setzen

            .Columns("G:G").AutoFilter

            'Spalte G filtern nach Werten > 0, Filter bis zur letzten gefuellten Zeile in Spalte G + 1

            'Es darf in Spalte G also nix unter den Daten stehen.

            .Range("$G$1:$G$" & .Cells(Rows.Count, 7).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=">0"

            'Tabellenname in temporaeres Blatt, Spalte C eintragen, letzte Zeile anhand Spalte G

            tmpWsh.Range("C" & tmpWsh.Cells(Rows.Count, 7).End(xlUp).Row + 1) = myWsh.Name

            'Zeile zum Einfuegen ermitteln, letzte Zeile anhand Spalte G + 2 (2 wegen Tabellennamen in Spalte C)

            iPasteRow = tmpWsh.Cells(Rows.Count, 7).End(xlUp).Row + 2

            'Bereich kopieren und in Tabelle2 einfuegen

            .Rows("2:" & .Cells(Rows.Count, 7).End(xlUp).Row).Copy tmpWsh.Range("A" & iPasteRow)

            'Zwischensumme

            'Summenzelle

            iSumRow = tmpWsh.Cells(Rows.Count, 5).End(xlUp).Row

            'mit der Summenzelle

            With tmpWsh.Range("F" & iSumRow + 1)

                'Zwischensumme einfuegen

                .Value = WorksheetFunction.Sum(Range("F" & iPasteRow & ":F" & iSumRow))

                'Euroformat

                .NumberFormat = "#,##0.00 $"

                'Zwischensumme merken / kumulieren

                sSum = sSum + .Value

            'Ende mit der Summenzelle

            End With

            'Autofilter in Spalte G zuruecksetzen

            .Columns("G:G").AutoFilter

            'Spalte A und B ausblenden

            .Columns("A:B").EntireColumn.Hidden = True

        'Ende Wenn die Summe von Spalte G > 0 ist, dann

        End If

    'Ende Wenn der Blattname vom temporaeren Blatt <> vom Blatt myWsh ist, dann

    End If

  'Ende mit dem Blatt myWsh

  End With

'Ende Schleife ueber alle Blaetter

Next

'temporaeres Blatt aktivieren

tmpWsh.Activate

'Mit der zelle fuer die Gesamtsumme

With Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 6)

  'Gesamtsumme eintragen

  .Value = sSum

  'In Zelle links daneben "Summe" eintragen

  .Offset(0, -1).Value = "Summe"

  'Euroformat

  .NumberFormat = "#,##0.00 $"

'Ende Mit der zelle fuer die Gesamtsumme

End With

'Spaltenbreite automatisch anpassen  '<-- hier

Cells.EntireColumn.AutoFit           '<-- hier

'Spalte A und B ausblenden

Columns("A:B").EntireColumn.Hidden = True

End Sub

Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Alex105

schauan

Alex105

Alex105

schauan

Alex105

schauan

Alex105

Alex105

schauan