Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: Hennes am Dezember 29, 2016, 17:09:40 Nachmittag
-
Hallo zusammen,
was das Aufzeichnen von Makros angeht, befinde ich mich noch in den Kinderschuhen, und bräuchte eure Hilfe.
Über ein Formularsteuerelement möchte ich folgendes Makro aktivieren.
Tabellenblatt 1 zeigt den Tagesverbrauch bestimmter Artikel.
Zelle A2= Datum (Heute())
Zelle A3= Artikelnummer
Zelle B3= Einzelpreis
Zelle C3= Anzahl
Zelle D3= Gesamtpreis
Tabellenblatt 2 soll nun den Monatsverbrauch selbiger Artikel anzeigen
Zelle A3= Artikelnummer
Zelle B3= Einzelpreis
Zelle C2 bis AG2= Datum (vom 1.1. bis 31.1. als Beispiel)
Zelle C3 bis AG3= Anzahl
Zelle AH3= Gesamtpreis
Das Makro soll nun bei Klick auf den Button, die Zelle $A$2 aus Tabellenblatt 1 mit den Zellen B2 bis AF2 vergleichen, und bei Übereinstimmung die Einträge der Spalte C ab Zelle C4 bis Zelle C100 in Tabellenblatt 1 kopieren, in Tabellenblatt 2 unter dem entsprechendem Datum einfügen, und die Werte in Spalte C ab Zelle C4 bis C100 in Tabellenblatt 1 enternen.
Die einzelene Makrofunktion für das Kopieren, Einfügen und Entfernen habe ich ja soweit hinbekommen. Jedoch die vorgehende Wenn-Funktion (Prüfung des Datums) macht mir Probleme.
Ich hoffe, dass mir hier jemand helfen kann.
Danke schonmal im Voraus.
Gruß Hennes
-
Hallo Hennes, schau Dir das angehängt Arbeitsblatt an. Die Prüfung erfolgt in einer For-Next-Schleife. Hier der Code:
Option Explicit
Sub SummeBilden()
Dim datAnfDatum As Date
Dim datEndDatum As Date
Dim lngZeilennr As Long
Dim i
Dim e
Dim curWert As Currency
datAnfDatum = ActiveSheet.Range("A2").Value
datEndDatum = ActiveSheet.Range("B2").Value
lngZeilennr = Columns(3).Find(What:=datAnfDatum, After:=ActiveSheet.Cells(1, 3), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Row
e = datEndDatum - datAnfDatum + lngZeilennr
For i = lngZeilennr To e
'Cells(i, 3).Select
curWert = ActiveSheet.Cells(i, 4).Value + curWert
Next i
ActiveSheet.Range("E2") = curWert
End Sub
-
Hallo StefKe,
erstmal vielen Dank für deine Bemühungen, aber leider entspricht das nicht so ganz meinen Vorstellungen.
Ich dachte eher an eine einfache Wenn-Funktion, wie Zb
Zelle C4 in Tabelle2: =wenn(Tabelle2!C2=Tabelle1!$A$2;"starte Markro Strg+x";"")
diese Formel dann von C4 bis AG4 in Tabelle2 kopieren, das Ganze als Makro aufzeichenen und dann dem Button zuweisen.
NUR... der Teil in der Formel, also das DANN, will nicht funktionieren.
Gruß Hennes
-
Hallo zusammen,
ich versuch´s einfach nochmal. Vielleicht ist es auch anschaulicher in der angehängten Datei.
Gruß Hennes
-
Hallo Hennes, die Ausführung eines Makros in eine Formel einzubinden ist mir nicht bekannt. Einfacher wäre es per Code:
- Das Datum aus "Tagesverbrauch"C2 mit "Gesamtverbrauch"C1:Q1" zu vergleichen.
- Ist das Datum bereits vorhanden werden die Werte zu entsprechenden Spalte dazuaddiert.
- Ist das Datum noch nicht vorhanden wird eine neue Spalte mit den Werten eingefügt.
- Als Letztes werden die Werte im Blatt "Tagesverbrauch" C5:C24 gelöscht.
Das Makro wird über eine Schaltfläche gestartet, welche sich auch in die Menueleiste einbinden lässt. Oder Du bastelst ein Userform.
Wenn das so passt können wir es Schritt für Schritt machen.
Stefan
-
Hallo Stefan,
das klingt super.
So machen wir´s.
Danke schonmal.
Liesse sich denn das Makro auch über meinen "Neu" Button starten???
Gruß Hennes
-
Hallo Hennes, das Makro kann über den "Neu"-Button gestartet werden.
2 Fragen: ist die Anzahl der Bauteile (20) fest, oder variabel. Und ist die Anzahl der Tage in "Gesamtverbrauch" Zeile 1 immer gleich oder variabel?
Gruß
Stefan
-
Hallo Stefan,
also die Anzahl der Bauteile ist fest. In der Originaldatei sind es jedoch 100 Bauteile. Ich hatte mir gedacht, dass ich das Makro dann entsprechend meiner Originaldatei anpassen kann.
Die Anzahl der Tage ist ebenfalls fest. Vom 01.01.17 bis 31.12.17...
Was mir grad noch einfällt.
Vielleicht wäre es sinnvoller, wenn man direkt die Spalte "Anzahl" und die Spalte "Gesamtpreis" nach Jahresverbrauch kopiert, da ich vorhaben, dann über Jahresverbrauch eine Pivottabelle zu erstellen. Somit erübrigt sich dann auch die Spalte "Gesamtsumme" im Jahresverbrauch. Das macht ja die Pivot von allein.
Gruß Hennes
-
Hallo Hennes, hier die Arbeitsmappe zurück. Vielleicht denkst Du über den Aufbau der Tabelle "Gesamtverbrauch" noch mal nach. Da diese Tabelle später mit einem Pivot-Table ausgewertet werden soll sind die Formatierungen und Verbindungen der Zellen eher nachteilig. Du solltest Dich auch dafür entscheiden die Datumsangaben in eine Spalte zu schreiben.
Hier der Code:
Sub Werte_uebertragen()
Dim dtDatum As Date
Dim wksTagesverbrauch As Worksheet
Dim wksGesamtverbrauch As Worksheet
Dim rngSuchbereich As Range
Dim rngDatumZelle As Range
Dim lngDatumReihe As Long
Dim arrWerte(19)
Dim i
Set wksTagesverbrauch = Worksheets("Tagesverbrauch")
Set wksGesamtverbrauch = Worksheets("Gesamtverbrauch")
Set rngSuchbereich = wksGesamtverbrauch.Range("C1:P1")
'falls das Datum noch nicht existiert wir eine neue Spalte eingefügt und beschriftet:
dtDatum = wksTagesverbrauch.Cells(2, 3)
Set rngDatumZelle = rngSuchbereich.Find(What:=dtDatum, After:=ActiveSheet.Cells(1, 3), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If rngDatumZelle Is Nothing Then
lngDatumReihe = WorksheetFunction.Count(wksGesamtverbrauch.Rows(1)) + 3
With wksGesamtverbrauch
.Activate
.Columns(lngDatumReihe).EntireColumn.Insert
.Range(Cells(1, lngDatumReihe), Cells(3, lngDatumReihe)).Merge
.Cells(1, lngDatumReihe) = dtDatum
End With
Else
lngDatumReihe = rngDatumZelle.Column
End If
'Die Werte vom Blatt "Tagesverbrauch" werden in ein Array geschrieben:
With wksTagesverbrauch
For i = 0 To 19
arrWerte(i) = .Cells(i + 5, 3).Value
Next i
.Range("C5:C24").ClearContents
End With
'Die Werte aus dem Array werden in die neue Spalte übertragen:
With wksGesamtverbrauch
For i = 0 To 19
.Cells(i + 5, lngDatumReihe) = arrWerte(i)
.Cells(i + 5, lngDatumReihe + 1).FormulaR1C1 = "=SUM(Gesamtverbrauch!RC3:RC" & lngDatumReihe & ")"
Next i
End With
End Sub
-
Hallo Stefan,
genial!!! TOP!!!
läuft.... auch in meiner Originaldatei...
habe mich auch dazu entschieden, keine Pivot drüber zu legen.
Ist so vollkommen ausreichend.
(erstmal... ;-) )
vielen, vielen Dank kann ich da nur sagen.
eine Frage noch...
wie würde solch ein Makro aussehen, wenn ich einen variablen Zellbereich
zB A3 bis Kxx von Tabellenblatt1 zu Tabellenblatt2 übertragen möchte, die
Einträge aus dem selben Zellbereich im Anschluss entfernen möchte, und die Einträge im
Tabellenblatt2 ab Zelle A2 fortlaufend sein sollen. Also jeder neue Übertrag soll
in die nächste freie Zeile erfolgen.
Gruß Hennes
-
Hi Hennes, Du musst die Größe des Datenfeldes (Zeilen,Spalten) ermitteln und das Array entsprechend anpassen. Arrays werden hier recht gut geklärt:
http://www.vba-wordwelt.de/grundsaetzliches/wichtige-funktionen/array/ (http://www.vba-wordwelt.de/grundsaetzliches/wichtige-funktionen/array/)
Eine andere Möglichkeit wäre das Datenfeld mit 2 Schleifen zu durchlaufen und so Zelle für Zelle zu kopieren.
Mit dem Code:" .Range("XX:DD").ClearContents " wird der Bereich im Tabellenblatt1 gelöscht.
-
Hallo Stefan,
Das Schreiben eines Code ist für mich ein unlösbares Problem.
Ich schaffe es wohl, ein Makro aufzuzeichnen, was mir die gewünschte Aktion ausführt.
Aber das ganze funktioniert immer nur ein mal, weil dann beim Einfügen immer wieder
alles überschrieben wird. Nur das ist ja nicht Sinn und Zweck des Ganzen.
Wäre super, wenn du mir nochmals helfen könntest.
Ich würde das Datenfeld festlegen auf B3:K35.
Gruß Hennes
-
o.k., dann baue bitte eine Tabelle so zusammen wie sie am Ende aussehen soll und wir erstellen dann den Code.
Stefan
-
Supi... Danke :)
Spalte A in Tagesbuchungen wird automatisch durch einen Code bei jedem neuen Eintrag gefüllt.
Übertragen werden soll dann der Bereich A3:K35 oder nur die gefüllten Zeilen in diesem Bereich, wobei die
Spalte "Bemerkungen" nicht immer gefüllt ist, jenachdem was einfacher geht.
Jeder neue Übertrag soll dann in die nächste leere Zeile in "Jahresübersicht" erfolgen.
-
Hallo Hennes, mit dem Code:
Sub Werte_Uebertragen()
Dim wksTag As Worksheet
Dim wksJahr As Worksheet
Dim lngZeileTag As Long
Dim lngZeileJahr As Long
Dim rngWerteJahr As Range
Dim i As Long
Dim x As Long
Dim arrWert()
Set wksTag = Worksheets("Tagesbuchungen")
Set wksJahr = Worksheets("Jahresübersicht")
lngZeileTag = WorksheetFunction.Count(wksTag.Range("A3:A35"))
If lngZeile = 0 Then Exit Sub
ReDim arrWert(lngZeileTag - 1, 10)
'alle Zellen wo in Spalte A ein Datum steht werden in das Array übertragen:
For i = 0 To lngZeileTag - 1
For x = 0 To 10
arrWert(i, x) = wksTag.Cells(i + 3, x + 1)
Next x
Next i
'alle Daten in Tabelle Tagesbuchungen werden gelöscht:
wksTag.Range("A3:K" & lngZeileTag + 2).ClearContents
'alle Werte in Tabellenblatt "Jahresübersicht" eintragen:
lngZeileJahr = WorksheetFunction.Count(wksJahr.Range("A:A"))
wksJahr.Activate
Set rngWerteJahr = wksJahr.Range(Cells(lngZeileJahr + 3, 1), Cells(lngZeileJahr + lngZeileTag + 2, 11))
For i = 0 To lngZeileTag - 1
For x = 0 To 10
rngWerteJahr.Cells(i + 1, x + 1) = arrWert(i, x)
Next x
Next i
End Sub
werden alle ausgefüllten Zeilen vom Tabellenblatt "Tagesbuchungen" in ein Array übertragen, dann wird der Bereich gelöscht und das Array in der Jahresübersicht unten angefügt. Du brauchst nur eine Möglichkeit den Code zu starten.
Soweit, sogut... mangels meiner VBA-Kenntnisse erschließt sich mir nicht der Sinn des im Tabellblatt "Tagesbuchungen" hinterlegt Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("J3:J7300")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
End If
Errorhandling:
Application.EnableEvents = True
If Target.Column <> 2 Then Exit Sub
If Target = "" Then
Target.Offset(0, -1) = ""
Else
Target.Offset(0, -1) = Date
End If
End Sub
Stefan
-
Hallo Stefan,
dieser Code sorgt lediglich dafür, dass bei jedem Eintrag in Spalte B automatisch das
Datum in Spalte A eingetragen wird.
Leider tut sich bei deinem Code bei mir nichts.
Kannst du noch mal drüber schauen???
Guß Hennes
-
Das aktuelle Datum lässt sich einfach mit der Tastenkombination Strg + Punkt eingeben.
Ein x-beliebiges Datum: 24-1 eingeben - wird von Exel in 24.01.2017 umgewandelt, je nach definiertem Zellformat.
Habe den Code im Tabellenblatt gelöscht und einen Button angelegt, welcher mein Makro startet.
Passt so?
-
Supi, jetzt geht´s... !!!
Jetzt hab ich nur noch ein klitzekleines Problem.
In den Spalten C bis H sind Formeln hinterlegt (SVerweis).
Diese Zellen können natürlich überschrieben werden, wenn der angezeigte Wert nicht passt.
Alle Formeln habe ich in ein Makro geschrieben, damit ich sie bei Bedarf wieder eintragen lassen kann.
Nun werden ja beim Übertragen der Werte meine Formeln gelöscht.
Kann man durch einen Befehl am Ende deines Codes mein Makro "Autofüllen" direkt ausführen lassen?
-
Ja sicherlich, stell das Makro hier ein...oder besser die Tabelle mit den Formel dazu....
-
hier einmal das Makro, welches im Tabellenblatt "Tagesbuchungen" laufen soll...
beides einzeln, also dein Code und mein Makro, funktioniert...
Sub Autofüllen()
'
' Autofüllen Makro
' Formeln eintragen
'
' Tastenkombination: Strg+y
'
Range("A3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",TODAY())"
Range("A4").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",TODAY())"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A34"), Type:=xlFillDefault
Range("A4:A34").Select
Range("A35").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",TODAY())"
Range("C3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(ISNA(MATCH(RC[-1],Abos!R3C2:R50C2,0)),""ohne Vertrag"",""mit Vertrag""))"
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(ISNA(MATCH(RC[-1],Abos!R3C2:R50C2,0)),""ohne Vertrag"",""mit Vertrag""))"
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C34"), Type:=xlFillDefault
Range("C4:C34").Select
Range("C35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(ISNA(MATCH(RC[-1],Abos!R3C2:R50C2,0)),""ohne Vertrag"",""mit Vertrag""))"
Range("D3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(RC[-1]=""ohne Vertrag"","""",VLOOKUP(RC[-2],Abos!R3C2:R50C7,2,FALSE)))"
Range("D4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(RC[-1]=""ohne Vertrag"","""",VLOOKUP(RC[-2],Abos!R3C2:R50C7,2,FALSE)))"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:D34"), Type:=xlFillDefault
Range("D4:D34").Select
Range("D35").Select
Selection.ClearContents
Range("E8:H21").Select
Selection.ClearContents
Range("D35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(RC[-1]=""ohne Vertrag"","""",VLOOKUP(RC[-2],Abos!R3C2:R50C7,2,FALSE)))"
Range("E3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]="""","""",IF(RC[-2]=""ohne Vertrag"","""",VLOOKUP(RC[-3],Abos!R3C2:R50C7,3,FALSE)))"
Range("E4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]="""","""",IF(RC[-2]=""ohne Vertrag"","""",VLOOKUP(RC[-3],Abos!R3C2:R50C7,3,FALSE)))"
Range("E4").Select
Selection.AutoFill Destination:=Range("E4:E34"), Type:=xlFillDefault
Range("E4:E34").Select
Range("E35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]="""","""",IF(RC[-2]=""ohne Vertrag"","""",VLOOKUP(RC[-3],Abos!R3C2:R50C7,3,FALSE)))"
Range("F3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-4]="""","""",IF(RC[-3]=""ohne Vertrag"","""",VLOOKUP(RC[-4],Abos!R3C2:R50C7,4,FALSE)))"
Range("F4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-4]="""","""",IF(RC[-3]=""ohne Vertrag"","""",VLOOKUP(RC[-4],Abos!R3C2:R50C7,4,FALSE)))"
Range("F4").Select
Selection.AutoFill Destination:=Range("F4:F34"), Type:=xlFillDefault
Range("F4:F34").Select
Range("F35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-4]="""","""",IF(RC[-3]=""ohne Vertrag"","""",VLOOKUP(RC[-4],Abos!R3C2:R50C7,4,FALSE)))"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]="""","""",IF(RC[-4]=""ohne Vertrag"","""",VLOOKUP(RC[-5],Abos!R3C2:R50C7,5,FALSE)))"
Range("G4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]="""","""",IF(RC[-4]=""ohne Vertrag"","""",VLOOKUP(RC[-5],Abos!R3C2:R50C7,5,FALSE)))"
Range("G4").Select
Selection.AutoFill Destination:=Range("G4:G34"), Type:=xlFillDefault
Range("G4:G34").Select
Range("G35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]="""","""",IF(RC[-4]=""ohne Vertrag"","""",VLOOKUP(RC[-5],Abos!R3C2:R50C7,5,FALSE)))"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]="""","""",IF(RC[-5]=""ohne Vertrag"","""",VLOOKUP(RC[-6],Abos!R3C2:R50C7,6,FALSE)))"
Range("H4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]="""","""",IF(RC[-5]=""ohne Vertrag"","""",VLOOKUP(RC[-6],Abos!R3C2:R50C7,6,FALSE)))"
Range("H4").Select
Selection.AutoFill Destination:=Range("H4:H34"), Type:=xlFillDefault
Range("H4:H34").Select
Range("H35").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]="""","""",IF(RC[-5]=""ohne Vertrag"","""",VLOOKUP(RC[-6],Abos!R3C2:R50C7,6,FALSE)))"
Range("H35").Select
End Sub
-
Hallo Hennes, die gelöschten Bereiche werden jetzt wieder mit den Formeln aufgefüllt.
-
Supi... Danke schön...
Hatte zwischenzeitlich auch noch eine Lösung gefunden.
Habe das Makro mit auf den CommandButton gelegt.
Also, vielen Dank nochmal für deine Mühe.
Einfach TOP!!