Makro funktioniert nur nach Datei öffnen :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

[Excel 2003] Makro funktioniert nur nach Datei öffnen

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

silex1
User mit gefährlichem Halbwissen

Anmeldedatum: 18.12.2007
Beiträge: 120
Wohnort: Dresden

Verfasst am: 20.02.2008, 15:45

Hallo,

anbei ne Tabelle in der durch "Eingabe" B7 der Monat verändert werden kann.
Daten werden ein- und ausgelesen bei Änderung. Dies funzt allerdings nur nach dem öffnen der Datei. Wenn anderes Makro (Neue Woche oder Daten speichern) ausgeführt wird, funzt es nich mehr. Wo ist der Fehler???????

Wäre auch gut, wenn ein Monat ausgewählt wird der noch nicht unter "Alle_Wochen" erfasst wurde, ne Fehler-Meldung kommt "Monat nich da, anlegen ja nein"

Bin wie immer dankbar für jede Hilfe.

Mappe2.xls

Beschreibung:

Download

Dateiname:

Mappe2.xls

Dateigröße:

66.5 KB

Heruntergeladen:

19 mal

schatzi
Moderator

Anmeldedatum: 09.12.2006
Beiträge: 5725

Verfasst am: 20.02.2008, 16:36

Hallo!

EnableEvents = False
darf erst nach der Zellabfrage (If Target.Address...) kommen.
Die Variable objEingabe brauchst du überhaupt nicht, da sich der Code ja im Modul dieses Blatts befindet.
Teste mal diese Korrektur, Verkürzung, Beschleunigung:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Verlasse den Code, wenn die geänderte Zelle nicht B7 ist:
If Target.Address <> "$B$7" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim objDaten As Worksheet
Dim lngR As Long, intC As Integer, lngEingabe As Long
Set objDaten = Sheets("Alle_Wochen")

With objDaten
Set rngtest = .Columns(1).Find(Range("B7"))
If Not rngtest Is Nothing Then
lngR = rngtest.Row
Else
MsgBox "Dieses Datum existiert noch nicht!" & vbLf & "Es wird angelegt."
.Range("A65536").End(xlUp).Offset(1, 0) = Range("B7")
lngR = .Range("A65536").End(xlUp).Row + 1
End If
For intC = 1 To 91
Select Case intC
Case 1 To 16 'Spalten 1 bis 16 (A bis P)
'Daten in B2:B22 eintragen
lngEingabe = 7 '1. Eingabezeile in Spalte B
If Not Cells(lngEingabe + intC - 1, 2).HasFormula Then
Cells(lngEingabe + intC - 1, 2).Value = .Cells(lngR, intC).Value
End If
Case 17 To 31 'Spalten 17 bis 31
'Daten in C3:C22 eintragen
lngEingabe = 8 '1. Eingabezeile in Spalte C
If Not Cells(lngEingabe + intC - 17, 3).HasFormula Then
Cells(lngEingabe + intC - 17, 3).Value = .Cells(lngR, intC).Value
End If
Case 32 To 46 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte D
If Not Cells(lngEingabe + intC - 32, 4).HasFormula Then
Cells(lngEingabe + intC - 32, 4).Value = .Cells(lngR, intC).Value
End If
Case 47 To 61 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte E
If Not Cells(lngEingabe + intC - 47, 5).HasFormula Then
Cells(lngEingabe + intC - 47, 5).Value = .Cells(lngR, intC).Value
End If
Case 62 To 76 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte F
If Not Cells(lngEingabe + intC - 62, 6).HasFormula Then
Cells(lngEingabe + intC - 62, 6).Value = .Cells(lngR, intC).Value
End If
Case 77 To 91 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte G
If Not Cells(lngEingabe + intC - 77, 7).HasFormula Then
Cells(lngEingabe + intC - 77, 7).Value = .Cells(lngR, intC).Value
End If
End Select
Next
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub NeueWoche_Click()
Range("B7").Value = ""
Range("B9:B13").Value = 0
Range("B16:B22").Value = 0
Range("C9:G13").Value = ""
Range("C16:G22").Value = 0
'Range("C27").Value = 0
End Sub
Private Sub WocheSpeichern_Click()
'SchutzAufheben ("abc123")
Dim objDaten As Worksheet
Dim rng As Range, rngF As Range, varSuchen As Variant
Dim lngN As Long, intC As Integer, lngEingabe As Long

Set objDaten = Worksheets("Alle_Wochen") 'Datentabelle

With objDaten
'Prüfen, ob Datum schon vorhanden
varSuchen = Range("B7").Text
Set rngF = .Columns(1).Find(what:=varSuchen, _
LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
'EinfügeZeile ermitteln
If Not rngF Is Nothing Then
lngN = rngF.Row
If MsgBox("vorhandenen Daten für """ & Range("B7").Text _
& """ überschreiben?", vbYesNo, "Daten Speichern") = vbNo Then
Exit Sub
End If
Else
lngN = Application.Max(2, .Cells(Rows.Count, 1).End(xlUp).Row + 1) 'erste freie Zeile in objDaten
End If
'Daten aus Eingabeblatt übertragen
For intC = 1 To 91 'Spaltenzähler
Select Case intC
Case 1 To 16 'Spalten 1 bis 16 (A bis P)
'Daten aus B2:B22 eintragen
lngEingabe = 7 '1. Eingabezeile in Spalte B
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 1, 2).Value
Case 17 To 31 'Spalten 17 bis 31 (Q bis W)
'Daten aus C3:C22 eintragen
lngEingabe = 8 '1. Eingabezeile in Spalte D
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 17, 3).Value
Case 32 To 46 'Spalten
'Daten aus D
lngEingabe = 8 '1. Eingabezeile in Spalte D
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 32, 4).Value
Case 47 To 61 'Spalten
'Daten aus E
lngEingabe = 8 '1. Eingabezeile in Spalte E
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 47, 5).Value
Case 62 To 76 'Spalten
'Daten aus F
lngEingabe = 8 '1. Eingabezeile in Spalte F
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 62, 6).Value
Case 77 To 91 'Spalten
'Daten aus F
lngEingabe = 8 '1. Eingabezeile in Spalte G
.Cells(lngN, intC).Value = Cells(lngEingabe + intC - 77, 7).Value

End Select
Next
'Daten Sortieren
lngN = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Datenzeile
.Range(.Rows(1), .Rows(lngN)).Sort _
Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
'Summenformel aktualisieren
If .Cells(lngN, 1).Value = "Alle" Then
For intC = 2 To 91
.Cells(lngN, intC).FormulaR1C1 = "=SUM(R[" & (-lngN + 2) & "]C[0]:R[-1]C[0])"
Next
End If
End With

Set objDaten = Nothing
Set rng = Nothing
Set rngF = Nothing

End Sub

_________________

Viele Grüße vom Schatzi
------------------------
Ich bin nur noch sporadisch erreichbar!
Bitte hofft nicht auf eine schnelle Beantwortung einer Rückfrage meinerseits!
Jeder andere Helfer darf Rückfragen gerne übernehmen!

silex1
User mit gefährlichem Halbwissen

Anmeldedatum: 18.12.2007
Beiträge: 120
Wohnort: Dresden

Verfasst am: 21.02.2008, 14:52

Hallo Schatzi,

Zitat:

Teste mal diese Korrektur, Verkürzung, Beschleunigung:

Du bist und bleibst ein Schatzi,

ja, es läuft nicht nur schneller sondern auch ruckelfrei! SUPER!!

Zitat:

EnableEvents = False
darf erst nach der Zellabfrage (If Target.Address...) kommen.
Die Variable objEingabe brauchst du überhaupt nicht

daher lese ich fast jede Deiner Antworten im Forum, Du erläuterst auch in verständlicher Sprache (nicht wie F1 bei Excel).

Danke Dir herzlich, LG silex1

silex1
User mit gefährlichem Halbwissen

Anmeldedatum: 18.12.2007
Beiträge: 120
Wohnort: Dresden

Verfasst am: 21.02.2008, 15:17

Hallo Schatzi,

hab gerade noch mal Daten eingetragen und rumgespielt.
Folgendes Problem:

Wenn ich die Datei geöfnet habe, kann ich mit "B7" supie arbeiten, auch das mit der Meldung (MsgBox) funktionert.
Leider geht dann nix mehr. Es werden immer wieder (auch bekannte Monate) neu angelegt.
Auch wenn ich innerhalb des bekannten Monats etwas ändere und speichere, kann ich dann nicht mehr mit "B7" arbeiten. Die Daten des bearbeiteten Monats bleiben stehen. Erst nach schließen und erneutem öffnen der Datei geht es wieder mit "B7".
Wenn man es weis, kann man so schon schön arbeiten. Es müssen aber auch andere damit arbeiten? Gibts da Abhilfe?

Hoffe, ich gehe Dir mit meinen 3 Gehirnzellen, nich so auf den Geist,

LG silex1

silex1
User mit gefährlichem Halbwissen

Anmeldedatum: 18.12.2007
Beiträge: 120
Wohnort: Dresden

Verfasst am: 21.02.2008, 15:18

schatzi
Moderator

Anmeldedatum: 09.12.2006
Beiträge: 5725

Verfasst am: 21.02.2008, 16:07

Hallo!

Sorry, keine Ahnung, was da los ist.
Ich habe das gleiche Problem, aber Abhilfe weiß ich leider auch nicht...

silex1
User mit gefährlichem Halbwissen

Anmeldedatum: 18.12.2007
Beiträge: 120
Wohnort: Dresden

Verfasst am: 22.02.2008, 12:36

Hallo Schatzi,

des Problem lag hier:

With objDaten
Set rngtest = .Columns(1).Find(Range("B7"), LookIn:=xlFormulas)
'Set rngtest = .Columns(1).Find(Range("B7"))

jetzt funzt es Dank deiner riesigen Vorarbeit!
Danke Dir nochmal!!!!! Bleib uns und dem Forum lange erhalten!!!
lg silex1

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Gross- Kleinschreibung nach Punkt	sipa67	Microsoft Excel Hilfe	2	22.11.2008, 12:52
	Anzeige eines HTML-Mails unter Vista ...	cbichler	Microsoft Outlook Hilfe	0	22.11.2008, 09:54
	Word 2007 Makro bringt Fehlermedlung ...	Ted	Microsoft Word Hilfe	0	21.11.2008, 21:31
	WQord 2007 fehler beim Makro (kopilie...	Ted	Microsoft Word Hilfe	0	21.11.2008, 07:40
	Vierecke Word - Datei nicht mehr lesb...	Limited	Microsoft Word Hilfe	2	20.11.2008, 11:07

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de