Makro

[Kempes]

Hallo allerseits

Ich habe ein Problem beim erstellen einer Dateneingabemaske in Excel für ein Kartenspiel. 
Ob mir da wohl jemand helfen kann? (Die noch nicht gelösten Probleme habe ich in einem Textfeld in der Datei hinterlegt)

  Guggitaler.xlsm (Größe: 30,76 KB / Downloads: 15)

[Bast4i]

Hallo Kempes.

Für Dein Problem 1: Nimm den Zelleninhalt und schreib ihn an die passende Stelle. Z. B.: Range("B1")=Range("H7")
Statt Range("B1") kannst Du übrigens auch Cells(1,2) schreiben. Das ist dann einfacher, um die Zeilennummer variabel zu gestalten. Du schreibst dann also Cells(1,2)=Cells(7,8)

Statt der 1 musst Du dann eine Variable nehmen. Die kannst Du entweder ab Spielbeginn immer mitzählen, oder Du suchst Dir jeweils das Tabellenende. Aber sollte das nicht eh der Wert aus B3 (s. Problem 2) sein?

Problem 2: lösche die Zeilen

 Range("B3").Select
 ActiveCell.FormulaR1C1 = "=RC+1"
 Range("B3").Select
 ActiveCell.FormulaR1C1 = "1"

und schreib stattdessen

Range("B3") = Range("B3") + 1
oder eben Cells(3,2)=Cells(3,2)+1

Gruß
Sebastian

P.S.: Räum doch bei Gelegenheit den Code etwas auf und hinterlass noch den ein oder anderen Kommentar. Das hilft Dir später bestimmt.....

[Kempes]

Hallo Sebastian

Vielen Dank für Deine rasche Antwort auf mein Excel Problem.

Das Problem 2 konnte ich mit Deiner Hilfe bereits bestens beheben und funktioniert so perfekt.

Beim Problem 1 hatte ich mich vermutlich zuwenig präzise ausgedrückt:
In Runde 2 müssten dann die Werte (Blatt"Daten") von den Zellen H7 bis H11 in die Zellen B2 bis E2 übertragen werden, in Runde 3 in B3 bis E3 etc., etc., etc.
Sodass der Zwischenstand (Blatt "Spieltabelle" I7 bis I10) nach jeder Spielrunde gleich aktualisiert und berechnet wird.

Gruss
Mario (Kempes)


P.S.: Betreffend den Codes aktualisieren; leider bin ich nur Hobby-Excel-Benutzer und der VBA-Programmierung nicht mächtig. Diesbezügliche Inputs nehme ich sehr gerne entgegen und werde versuchen sie umzusetzen. ;)

[schauan]

Hallöchen,

ein bisschen hilft da der Makrorekorder. Aufgezeichnet bekommst Du z.B. das - wobei ich mir hier erlaubt habe, nur H7:H10 zu übertragen. B3:E3 sind nur 4 Zellen, da tut sich Excel vielleicht etwas schwer mit 5 Quellzellen :

Code:

Sub Makro2()
'
' Makro2 Makro
'

'
   Range("H7:H10").Select
   Selection.Copy
   Sheets("Daten").Select
   Range("B3").Select
   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
   Sheets("Spieltabelle").Select
   Range("H6").Select
   Application.CutCopyMode = False
End Sub

So, dann mal einkürzen:

Code:

Sub Makro3()
   Range("H7:H10").Copy
   Sheets("Daten").Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
   Range("H7").Select
   Application.CutCopyMode = False
End Sub

und jetzt noch die Runde, die steht immer eine Zeile weiter als die Zahl ...:

Code:

Sub Makro4()
   Range("H7:H10").Copy
   Sheets("Daten").Range("B" & Range("B3").Value + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
   Range("H7").Select
   Application.CutCopyMode = False
End Sub

[Kempes]

Hallo André, vielen Dank für Deinen Input. Leider funktioniert bei mir immer noch nicht alles wunschgemäss. Den folgenden Code habe ich auf den Button "Runde abschliessen" hinterlegt und funktioniert soweit, dass die Werte so kopiert werden wie ich es möchte.

Code:

Sub Runde_abschliessen()
'
' Runde_abschliessen Makro
'

'
   Sheets("Daten").Select
   Range("G8").Select
   Selection.Copy
   Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
       xlNone, SkipBlanks:=False, Transpose:=False
   
   Range("G9").Select
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
       xlNone, SkipBlanks:=False, Transpose:=False
       
   Range("G10").Select
   Selection.Copy
   Range("C2").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
       xlNone, SkipBlanks:=False, Transpose:=False
       
   Range("G11").Select
   Selection.Copy
   Range("D2").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
       xlNone, SkipBlanks:=False, Transpose:=False
       
   Sheets("Spieltabelle").Select
   Range("B4").Select
   Application.CutCopyMode = False
   
End Sub

Beim zweiten Button "Neue Runde starten" ist folgender Code hinterlegt:

Code:

Sub Neue_Runde_starten()
'
' Neue_Runde_starten Makro
'

'
   Range("C7").Select
   Selection.ClearContents
   Range("C8").Select
   Selection.ClearContents
   Range("C9").Select
   Selection.ClearContents
   Range("C10").Select
   Selection.ClearContents
   Range("F7").Select
   Selection.ClearContents
   Range("F8").Select
   Selection.ClearContents
   Range("F9").Select
   Selection.ClearContents
   Range("F10").Select
   Selection.ClearContents
   Range("B3") = Range("B3") + 1
   Range("F12").Select
   ActiveSheet.Shapes.Range(Array("Button 9")).Select
   Selection.OnAction = "Neue_Runde_starten"
   Range("C7").Select
   ActiveCell.FormulaR1C1 = "100"
   Range("C8").Select
   ActiveCell.FormulaR1C1 = "70"
   Range("C9").Select
   ActiveCell.FormulaR1C1 = "0"
   Range("C10").Select
   ActiveCell.FormulaR1C1 = "0"
   Range("F7").Select
   ActiveCell.FormulaR1C1 = "1"
   Range("F8").Select
   ActiveCell.FormulaR1C1 = "2"
   Range("F9").Select
   ActiveCell.FormulaR1C1 = "3"
   Range("F10").Select
   ActiveCell.FormulaR1C1 = "4"
   Range("C7").Select
   Selection.ClearContents
   Range("C8").Select
   Selection.ClearContents
   Range("C9").Select
   Selection.ClearContents
   Range("C10").Select
   Selection.ClearContents
   Range("F7").Select
   Selection.ClearContents
   Range("F8").Select
   Selection.ClearContents
   Range("F9").Select
   Selection.ClearContents
   Range("F10").Select
   Selection.ClearContents
   Range("B3").Select
   ActiveWorkbook.Save
End Sub

Der funktioniert soweit auch (obwohl man diesen sicherlich auch noch kürzen könnte)

Ab der zweiten Runde beginnt nun aber mein hauptsächliches Problem welches nach wie vor nicht gelöst ist. 
Nämlich, dass die mittlerweile gelöschten Daten aus Runde 1 (durch drücken des Button "Neue Runde starten" im Sheet "Daten" G8 bis G11) nun die neuen Daten aus Runde 2 enthalten. Welche wiederum kopiert werden sollten aber diesmal von G8 auf A3; G9 auf B3; G10 auf C3; G11 auf D3.
Und so ginge es weiter; nach Runde 3 müssten die Werte in A4 bis D4, etc. etc. etc.

Ich lade meine aktuelle Dateiversion nochmals hoch und hoffe, dass ihr die Geduld mit mir nicht verliert...  
Vielen Dank für Eure bisherigen Inputs und ein schönes Wochenende
Mario (Kempes)

[schauan]

Hallöchen,

zuerst mal eine Frage. Ist der geänderte Aufbau jetzt korrekt? Im anderen Muster war ja noch eine andere Vorgehensweise mit den verschiedenen Runden. Wie willst Du jetzt die Runden dokumentieren? Wie Du schreibst bzw. man in Deinem Muster sieht, ist ja kein Platz mehr für die vorhergehenden Runden?

Meine codes hast Du auch nicht verarbeitet - hast Du den wenigstens mal ausprobiert? Du kannst da sehen, wie man einen Bereich in einem Rutsch überträgt. Du machst das ja mit den einzelnen Zellen.


Das es mit den Bereichen nicht so klappt, merkt man auch da:

Code:

Range("C7").Select
   Selection.ClearContents
   Range("C8").Select
   Selection.ClearContents
   Range("C9").Select
…

Das kann man zusammenfassen auf zwei Zeilen:

Range("C7:C10").ClearContents
Range("F7:F10").ClearContents

[Kempes]

Hallo André

Ja, ich hatte gestern fast 3 Stunden lang versucht Deine Codes einzusetzen. Aber mein Wissen reichte leider nicht aus um die Sache wunschgemäss und funktional einzubauen. Entweder erhielt ich Fehlermeldungen oder es kopierte dann einfach zuviele Zellen miteinander auf einmal. 

Ich möchte ja eigentlich nur, dass jeweils die 4 Zellen (Blatt "Daten" G8 bis G11) im selben Blatt nach Zellen (A2 bis D2) kopiert werden (Nur Inhalte und Werte). 
Dann in der nächsten Runde, die neuen Resultate in die 4 Zeilen darunter (A3 bis D3) etc., etc., etc. Runde für Runde jeweils immer in die nächsten Zellen darunter...

In diesem fortlaufenden Summentotal (Spalten A bis D) berechnet sich dann immer von Neuem der Zwischenstand nach jeder Runde neu. 
Hiermit wären auch die Runden dokumentiert. Die Zellen G8 bis G11 dienen dabei nur als Zwischenspeicher um das jeweilige Rundentotal aus dem Spieltabellenblatt zu berechnen.
Aber eben...noch nicht geschafft...

Aus Verzweiflung habe ich dann die Makros nochmals neu aufgezeichnet und nur die Codes/Anpassungen (vom Forum hier) eingeführt welche bei mir einwandfrei funktionieren.
(Beispielsweise den Tipp mit "B3=B3+1 oder die Zusammenfassungen (Range"C7:C11" und "F7:F11" habe ich übrigens auch gerade erfolgreich implementiert, vielen Dank)

Mir fehlt einfach nach wie vor der eine Punkt, dass nach jeder Runde die Zwischenresultate aus G8 bis G11 immer eine Zeile tiefer in die Spalten A bis D eingefügt werden sollten.

Schönen Abend noch und Danke für die Bemühungen für mein Problem

[schauan]

Hallöchen,

im ersten Beispiel ging das ja einfach über die Rundennummern in Zusammenhang mit den Zeilennummern und das sollte jetzt ähnlich sein. Die Daten stehen jetzt auch auf dem Datenblatt und der Zielbereich fängt schon in Spalte A an. Ich baue dazu nur mal mein Makro4 um. Beim Start muss die Spieletabelle aktiv sein, aber das ist sie ja auch Ansonsten müsste man noch das Sheet vor die Zelle ...B3... schreiben

Code:

Sub Makro4()
   Sheets("Daten").Range("G8:G11").Copy
   Sheets("Daten").Range("A" & Range("B3").Value + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
   Application.CutCopyMode = False
End Sub

[Kempes]

Hallo André

Perfekt! Die beiden Codes sehen bei mir jetzt so aus und....es funktioniert, vielen herzlichen Dank!!!

Einzig beim Blattschutz erscheinen mir jetzt noch Laufzeitfehler. Muss man, um dies zu umgehen, auch noch die Codes anpassen?

Code:

Sub Runde_abschliessen()
'
' Runde_abschliessen Makro
'

'
   Sheets("Daten").Range("G8:G11").Copy
  Sheets("Daten").Range("A" & Range("B3").Value + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=True
  Application.CutCopyMode = False
   
End Sub

Code:

Sub Neue_Runde_starten()
'
' Neue_Runde_starten Makro
'

'
   Range("C7:C10").ClearContents
   Range("F7:F10").ClearContents
   Range("B3") = Range("B3") + 1
   ActiveSheet.Shapes.Range(Array("Button 9")).Select
   Selection.OnAction = "Neue_Runde_starten"
   ActiveWorkbook.Save
   
End Sub

[schauan]

Hallöchen,

wenn Du einen Blattschutz setzt, musst Du ihn natürlich temporär aufheben, um Zelleinträge zu ändern.

Hier mal wieder was aufgezeichnetes:

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    ActiveSheet.Unprotect
End Sub

Das hilft diesmal auch nicht ganz, es fehlt in der Aufzeichnung die Passwortabfrage
Mit Passwort und ohne Optionen würde es so aussehen:

Code:

Sub Makro1()
    ActiveSheet.Protect Password:="MeinPasswort"
    ActiveSheet.Unprotect  Password:="MeinPasswort"
End Sub

Im Makro zum Übertragen dann so:

Code:

Sub Runde_abschliessen()
'
' Runde_abschliessen Makro
'
    Sheets("Daten").Unprotect Password:="MeinPasswort"
    Sheets("Daten").Range("G8:G11").Copy
   Sheets("Daten").Range("A" & Range("B3").Value + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
   Application.CutCopyMode = False
    Sheets("Daten").Protect  Password:="MeinPasswort"
    
End Sub

Du siehst hier, dass recht häufig Sheets("Daten") steht. Da kann man auch noch was vereinfachen:

Code:

Sub Runde_abschliessen()
'
' Runde_abschliessen Makro
'
    With Sheets("Daten")
       .Unprotect Password:="MeinPasswort"
       .Range("G8:G11").Copy
       .Range("A" & Range("B3").Value + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True
       Application.CutCopyMode = False
       .Protect  Password:="MeinPasswort"
    End With
End Sub

Vorteilhaft wäre noch eine Fehlerbehandlung. Wenn beim Kopieren ein Fehler kommt, dann bleibt Dein Blatt ungeschützt, wenn der Anwender die Makroausführung abbricht.

Bei dieser einfachen Aufgabe könnte man ausnahmsweise mal am Anfang
On Error Resume Next
verwenden.