Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
876to880
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schreibschutzproblem nach Kopier-Code

Schreibschutzproblem nach Kopier-Code
10.06.2007 13:50:00
Frank
Hallo!
Ich habe ein ungewöhnliches Problem. In meinem Datenbankblatt werden nach der Ausführung des unten aufgeführten Codes alle Zellen schreibgeschützt. Zumindest bekomme ich die Meldung wenn ich darin arbeite. Der Blattschutz ist jedoch weder an, noch ist der Formateigenschaften der Zellen ausgewählt. Der Code wird bei Ausführung mit der Laufzeitfehler 13 "Typen unverträglich" beendet. Ich schätze, das liegt am selben Problem. Hat jemand eine Idee, wo der Fehler liegt?
Dim suchid1 As String, SuchAddresse As String
Dim Bereich As Range, DatenBereich As Range
Dim Sicherheit1 As Range
Dim keineDaten As Boolean
suchid1 = Sheets("1").Range("A2") 'Suchwert
Set Sicherheit1 = Sheets("DB K1").Cells.Find(suchid1)
For Each Bereich In Sheets("DB K1").Range("A1:HF" & [=COUNTA('DB K1'!A:A)])
'Prüfe ob Wert in (DB K1!)
If Sicherheit1 Is Nothing Then
SuchAddresse = _
Range(Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 1).Address _
& ":" & Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 214). _
Address).Address
keineDaten = True
GoTo eingabe
End If
If Bereich = suchid1 Then
SuchAddresse = Range(Cells(Bereich.Row, 1).Address & ":" & Cells(Bereich.Row, 214). _
Address).Address
eingabe:
For Each DatenBereich In Sheets("1").Range(SuchAddresse)
Sheets("DB K1").Range(DatenBereich.Address) = _
Sheets("1").Cells(2, DatenBereich.Column) 'Bereich mit 1!A2:HF2 Überschreiben
Next DatenBereich
End If
If keineDaten = True Then Exit For
Next Bereich
Gruß Frank

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 15:19:33
Daniel
Hallo
bei welcher Zeile bricht der Kode den ab?
ist das das einzige Makro in deiner Datei oder wie kommst du darauf, daß das Problem in diesem Codeschnipsel liegen muß?
Das ganze scheint mir sowieso nicht ganz sauber programmiert zu sein.
- auch wenn es funktionieren sollte, ist ein Sprung per Goto aus einem IF-Block heraus mitten in einen anderen IF-Block hinein (unter umgehung der 2. IF-Abfrage) alles andere als ein sauberer Progammierstil.
- abgesehen davon, dass das hier ziemlich umständlich ist und sicherlich einfacher geht:

SuchAddresse =Range(Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 1).Address & ":" & Cells( _
Range("A50000").End(xlUp).Offset(1, 0).Row, 214). Address).Address
beispielsweise so:
SuchAddresse = "$A$" & cells(50000,1).end(xlup).row+1 & ":$HF$" &  cells(50000,1).end(xlup).row+1


für die CELLS() ist kein Sheet angeben, damit wird automatisch das gerade aktive verwendet.
bist du sicher, das das so gewünscht und richtig ist?
es steht nirgeswo davor ein SHEETS().SELECT, somit kann jedes beliebige Sheet gerade aktiv sein
Kannst du mal die Datei hochladen, sonst ist schwer was zu sagen, da in diesem Kodeschnipsel nichts vorkommt, was mit Blattschutz zu tun haben könnte?
btw. wenn du in dieser Zeile


For Each Bereich In Sheets("DB K1").Range("A1:HF" & [=COUNTA('DB K1'!A:A)])


den bereich bis zur letzten verwendeten Zeile erweitern willst, solltest du lieber das hier verwenden:


For Each Bereich In Sheets("DB K1").Range("A1:HF" & sheets("DB K1").Range("A65536").end(xlup).row)


bei COUNTA werden u.U. vorhandene Leerzelle NICHT mitgezählt.
Gruß, Daniel

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 15:37:00
Frank
Hallo!
Danke für die Rückmeldung! Ich habe Hajo_Zi die Datei schon gemailt. Er hatte sie gestern schonmal. Ich melde mich sonst nochmal und warte erstmal ab.
Gruß Frank

AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 15:59:17
Hajo_Zi
Hallo Frank,
bei mir kommt Fehler beim Code.
Ich habe mir jetzt erstmal den Code angesehen und einige Änderungen vorgenommen. Zum Auslösen des Codes habe ich keine Anleitung.

Sub StD_kopier()
' StD_kopier Makro
Application.ScreenUpdating = True
'   wozu müssen die Tabellen ein und ausgeblendet werden
'   einblenden muss nur zum Drucken erfolgen
Sheets("0").Visible = True
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("0").Rows("3:3").Copy
Sheets("1").Rows("2:2").PasteSpecial Paste:=xlPasteValues
Sheets("0").Rows("6:6").Copy
Sheets("2").Rows("2:2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Sub DB_K1_akt()
Dim suchid1 As String, SuchAddresse As String
Dim Bereich As Range, DatenBereich As Range
Dim Sicherheit1 As Range
Dim keineDaten As Boolean
Application.ScreenUpdating = True
'   wozu müssen die Tabellen ein und ausgeblendet werden
'   einblenden muss nur zum Drucken erfolgen
Sheets("0").Visible = True
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("DB K1").Visible = True
Sheets("DB K2").Visible = True
Sheets("StD2").Visible = True
Call StD_kopier
suchid1 = Sheets("1").Range("A2") 'Suchwert
Set Sicherheit1 = Sheets("DB K1").Cells.Find(suchid1)
For Each Bereich In Sheets("DB K1").Range("A1:HF" & Application.WorksheetFunction.CountA( _
Worksheets("DB K1").Column(1)))
'Prüfe ob Wert in (DB K1!)
If Sicherheit1 Is Nothing Then
SuchAddresse = _
Range(Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 1).Address _
& ":" & Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 214). _
Address).Address
keineDaten = True
GoTo eingabe
End If
If Bereich = suchid1 Then
SuchAddresse = Range(Cells(Bereich.Row, 1).Address & ":" & Cells(Bereich.Row, 214).  _
_
Address).Address
eingabe:
For Each DatenBereich In Sheets("1").Range(SuchAddresse)
Sheets("DB K1").Range(DatenBereich.Address) = _
Sheets("1").Cells(2, DatenBereich.Column) 'Bereich mit 1!A2:HF2 Ü _
berschreiben
Next DatenBereich
End If
If keineDaten = True Then Exit For
Next Bereich
'   wozu müssen die Tabellen ein und ausgeblendet werden
'   einblenden muss nur zum Drucken erfolgen
Sheets("0").Visible = False
Sheets("1").Visible = False
Sheets("2").Visible = False
Sheets("DB K1").Visible = False
Sheets("DB K2").Visible = False
Sheets("StD2").Visible = False
End Sub


Sub DB_K2_akt() anlaog

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 16:39:00
Frank
Hallo!
Danke für die schnelle Überarbeitung.
Die Register wurden nur übersichtshalber ein und ausgeblendet. Es werden später noch mehr hinzukommmen. So bleibt es noch überschaubar. Mit meinem stümperhaften Code konnte ich aus den ausgeblendeten Blätter keine Daten kopieren.
Gruß Frank

AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 16:41:49
Hajo_Zi
Hallo Frank,
Du hast es bestimmt getestet, mit meinem Code ist es nicht notwendig.
Gruß Hajo

AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 17:05:45
Frank
Hallo!
Wird gerade eingebaut. Der Fehler in der Datenbank gab übrigens auch noch ganz woanders. Die automatische ID-Vergabe in "StD!" (C2) habe ich dummerweise mit einem späteren Makro versaut. Daher habe ich mir die ganzen Probedatensätze verhunzt. Ist aber wieder OK! Danke nochmal!
Gruß Frank

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 19:49:00
Frank
Hallo nochmal!
Der Code funktioniert nun (habe aber wieder den alten genommen und etwas angepasst. Der neue hat - warum auch immer nicht funktioniert. Der Fehler wurde immer in dieser Zeile angezeigt.
For Each Bereich In Sheets("DB K1").Range("A1:HF" & Application.WorksheetFunction.CountA( _
Worksheets("DB K1").Column(1)))
Meine Kenntnisse bringen mich da aber nicht weiter. Der funktionierende Code sieht jetzt so aus:

Sub DB_K1_akt()
Application.ScreenUpdating = False
Call StD_kopier
Dim suchid1 As String, SuchAddresse As String
Dim Bereich As Range, DatenBereich As Range
Dim Sicherheit1 As Range
Dim keineDaten As Boolean
suchid1 = Sheets("1").Range("A2") 'Suchwert
Set Sicherheit1 = Sheets("DB K1").Cells.Find(suchid1)
For Each Bereich In Sheets("DB K2").Range("A1:HF" & [=COUNTA('DB K2'!A:A)])
'Prüfe ob Wert in (DB K1!)
If Sicherheit1 Is Nothing Then
SuchAddresse = Range(Cells(Range("A50000").End(xlUp).Offset(1, 0).Row, 1).Address & ":" &  _
Cells( _
Range("A50000").End(xlUp).Offset(1, 0).Row, 214).Address).Address
keineDaten = True
GoTo eingabe
End If
If Bereich = suchid1 Then
SuchAddresse = Range(Cells(Bereich.Row, 1).Address & ":" & Cells(Bereich.Row, 214). _
Address).Address
eingabe:
For Each DatenBereich In Sheets("1").Range(SuchAddresse)
Sheets("DB K1").Range(DatenBereich.Address) = _
Sheets("1").Cells(2, DatenBereich.Column) 'Bereich mit 1!A2:HF2 Überschreiben
Next DatenBereich
End If
If keineDaten = True Then Exit For
Next Bereich
End Sub


Das einzigste Problem ist nun, dass die ID bei der Aktualisierung immer wieder als Text gespeichert wird. Das verhindert aber meine automatische ID-Vergabe bei Neukunden. Kann ich das ändern?
Gruß Frank

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 20:31:00
Hajo_Zi
Hallo Daniel,
Dine bessere Methode liefert nur ein falsches Ergebnis falls die Zelle 65536 belegt ist.
Gruß Hajo

AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 22:11:00
Daniel
Hallo
COUNTA liefert jedesmal ein falsches Ergebnis, wenn die abgefragte Spalte Leerzellen enthält.
bleibt die Frage offen, was wahrscheinlicher ist.
da er selber ein paar Zeilen weiter unten das End(xlup) verwendet, glaube ich kaum, daß seine Dateien bis zur letzten Zeile gefüllt sind.
dann würde auch diese Schleife:
For Each Bereich In Sheets("DB K2").Range("A1:HF" & [=COUNTA('DB K2'!A:A)])
65536x214 mal durchlaufen werden (hab jetzt keine Lust das ausrechenen)
und er hätte wahrscheinlich ein Performance-Problem, vorallem mit Range-Objektvariablen in der Schleife
Gruß, Daniel

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 22:24:28
Original
Hi,
du leistest hier tolle Arbeit, aber Programmierung hat nichts mit Wahrscheinlichkeiten zu tun.
Wenn du End(xlup) verwendest, ist es ein Leichtes, zu prüfen, ob die Zelle, Rows.Count ist hier
im Hinblick auf Kompatibilität die bessere Wahl, leer ist.
mfg Kurt

AW: Schreibschutzproblem nach Kopier-Code
12.06.2007 21:41:00
Daniel
doch, Progammieren hat viel mit Wahrscheinlichkeit zu tun, vor allem, wenn nur lückenhafte oder unvollständige Informationen vorliegen (wie oftmals hier im Forum). Dann muß man halt was annehmen und sich von mehreren Möglichkeiten für die wahrscheinlichtste entscheiden (oder für die unwahrscheinlichste, je nach dem was wahrscheinlicher zutriftt ;-)))
Gruß, Daniel

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
10.06.2007 22:36:02
Frank
Hallo!
Ich bin leider erst jetzt wieder zurück. Also die fehlerhafte Zeile war kopiert- probiere es nochmal mit der Änderung.
Die ID steht in Spalte A und zwar in beide Blättern ("1" & "DB K1"). Der Code finden den passenden Datensatz in DB K1 anhand der ID aus Blatt "1!" (Spalte A, Zeile 2) und überschreibt ihn mit der 2. Zeile aus Blatt "1!"
Soweit klappt das auch. Nur sind alle ID Felder als Zahlen formatiert. nach der Codeausführung ist die ID in DB K1 jedoch als Text gespeichert. Lege ich nun einen neuen Datensatz an erkennt meine automatische ID-Vergabe diese "Zahl" nicht und somit wird dieser Datensatz immer wieder überschrieben.
Gruß Frank

Anzeige
AW: Schreibschutzproblem nach Kopier-Code
12.06.2007 21:16:34
Daniel
Hallo
schreib mal so zurück:

Sheets("DB K1").Range(DatenBereich.Address).value = Sheets("1").Cells(2, DatenBereich.Column).value


wenn du ohne den Zusatz .VALUE die Daten überträgst, wird das Präfix, das den STRING kennzeichnet, mit übertragen. Wenn du .VALUE verwendest, wird das Präfix nicht mit übertragen und den TEXT (der nur aus Zahlen besteht), wird von Excel automatisch in eine Zahl umgewandelt.
Gruß, Daniel

AW: Schreibschutzproblem nach Kopier-Code
12.06.2007 22:12:22
Frank
Hallo!
Klappt super - Danke!
Ich hatte inzwischen ins Makro eingebaut, das in Spalte A alle Werte mal eins multipliziert werden. Das ging auch, so ist es natürlich eleganter.
Gruß Frank
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige