Registriert seit: 20.06.2021
Version(en): 2019
Ok jetzt komme ich mit.
Sollte ich jetzt aber die Verbundenen Zellen auflösen sollte es ja kein Problem mehr geben richtig?
Registriert seit: 11.04.2014
Version(en): Office 365
21.01.2022, 11:48
(Dieser Beitrag wurde zuletzt bearbeitet: 21.01.2022, 11:55 von Klaus-Dieter.)
Hallo Tom,
an der Stelle nicht. Leider hast du dein Makro ja nicht mit vorgestellt.
Verbundene Zellen haben ja die Unart, dass dort die obere linke Zelle den Bereich der Verbindung überlagert. Somit ist also nur diese Zelle die richtige Adresse. Die anderen Zellen sind also nicht weg, sondern liegen unter einer "aufgeblähten" Zelle. Der Ausdruck verbundene Zellen ist aus dieser Sicht falsch, oder zumindest irreführend.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter,
der Misserfolg ist ein Waisenkind
Richard Cobden
Registriert seit: 04.11.2014
Version(en): Office 365 Beta
Hi,
ich bin da bei Klaus-Dieter, da ich bis jetzt keinen vernünftigen Grund für die verbundenen Zellen in Deiner Datei sehe. Du kannst das doch alles über Zeilenhöhe und Spaltenbreite steuern.
Welche Info fehlt also für die zwingende Notwendigkeit verbundener Zellen?
Registriert seit: 20.06.2021
Version(en): 2019
Danke euch für die Infos haben mir allein schon sehr geholfen.
Ich werde jetzt mal die Verbundenen Zellen lösen und mein Arbeitsblatt anpassen.
Ich melde mich sobald ich fertig bin
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Tom,
teste es mal so:
Code: For ck = ColKey To LastColKey
'Hole nächsten Wert von "Schl:Schlüssel"
' Memory = wb.Sheets("Matrix").Cells(RowKey, ck).Address
' wb.Sheets("Matrix").Range(Memory).Cells.Locked = True
wb.Sheets("Matrix").Cells(RowKey, ck).MergeArea.Locked = True
Next ck
Gruß Uwe
Registriert seit: 20.06.2021
Version(en): 2019
Hi Uwe,
DU BIST MEIN RETTER!!!!!!
Vielen Dank es funktioniert.
Registriert seit: 20.06.2021
Version(en): 2019
21.01.2022, 19:05
(Dieser Beitrag wurde zuletzt bearbeitet: 21.01.2022, 19:09 von tomcat.)
Hi ich nochmals,
hier der Code:
Code: Sub ProtectKey()
'Workbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Positionen
Dim ColKey As Integer
Dim LastColKey As Integer
Dim RowKeyDate As Long
Dim RowKeyName As Long
Dim RowKeyPcs As Long
Dim RowKeyLock As Long
Dim RowCyl As Long
Dim LastRowCyl As Long
Dim ColCylDoorNo As Integer
Dim ColCylName As Integer
Dim ColCylType As Integer
Dim ColCylSizeA As Integer
Dim ColCylSizeI As Integer
Dim ColCylLock As Integer
Dim ColCylStore As Integer
Dim ColCylDate As Integer
Dim RowCylDate As Long
Dim ColKeyDate As Integer
'For-Schleifen
Dim KCol As Integer
Dim CRow As Long
Dim MCol As Integer
Dim MRow As Long
'Variablen
'Schlüssel
ColKey = 12
RowKeyDate = 1
RowKeyName = 4
RowKeyPcs = 10
RowKeyLock = 12
'Schließzylinder
RowCyl = 15
ColCylDoorNo = 2
ColCylName = 3
ColCylType = 4
ColCylSizeA = 5
ColCylSizeI = 6
ColCylLock = 7
ColCylStore = 8
ColCylDate = 10
'Schließmatrix
ColKeyDate = 12
RowKeyDate = 1
ColCylDate = 10
RowCylDate = 15
'Schlüssel
'Suche in Zeile "Datum" die letzte gefüllte Zelle
LastColKey = wb.Sheets("Matrix").Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Schleife für alle Schlüssel mit einem Datum und sperre die Zelle
For KCol = ColKey To LastColKey
wb.Sheets("Matrix").Cells(RowKeyDate, CK).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyName, CK).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyPcs, CK).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyLock, CK).MergeArea.Locked = True
Next KCol
'Zylinder
'Suche in Spalte "Datum" die letzte gefüllte Zelle
LastRowCyl = wb.Sheets("Matrix").Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle Schließzylinder mit einem Datum und sperre die Zelle
For CRow = RowCyl To LastRowCyl
wb.Sheets("Matrix").Cells(ColCylDoorNo, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylName, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylType, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylSizeA, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylSizeI, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylLock, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylStore, RC).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylDate, RC).MergeArea.Locked = True
Next CRow
'Schließung
'Suche in Zeile "Datum":Schlüssel die letzte gefüllte Zelle
LastColKey = wb.Sheets("Matrix").Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Suche in Zeile "Datum":Schließzylinder die letzte gefüllte Zelle
LastRowCyl = wb.Sheets("Matrix").Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle gefundenen Zellen in Matrix und sperre die Zellen
'Finde Zeile
For MCol = ColKeyDate To LastColKey
'Finde Spalte
For MRow = RowCylDate To LastRowCyl
'Sperre die gefundene Zelle
wb.Sheets("Matrix").Cells(MRow, MCol).Locked = True
Next MRow
Next MCol
End Sub
Soweit funktioniert alles bestens nur der Schutz für die "Schließzylinder möchte sich nicht einschalten.
Leider weiß ich hier nicht warum...
Vielen Dank euch!
Sorry leider einen falschen Code gesendet jetzt der Richtige!
Code: Sub ProtectKey()
'Workbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Positionen
Dim ColKey As Integer
Dim LastColKey As Integer
Dim RowKeyDate As Long
Dim RowKeyName As Long
Dim RowKeyPcs As Long
Dim RowKeyLock As Long
Dim RowCyl As Long
Dim LastRowCyl As Long
Dim ColCylDoorNo As Integer
Dim ColCylName As Integer
Dim ColCylType As Integer
Dim ColCylSizeA As Integer
Dim ColCylSizeI As Integer
Dim ColCylLock As Integer
Dim ColCylStore As Integer
Dim ColCylDate As Integer
Dim RowCylDate As Long
Dim ColKeyDate As Integer
'For-Schleifen
Dim KCol As Integer
Dim CRow As Long
Dim MCol As Integer
Dim MRow As Long
'Variablen
'Schlüssel
ColKey = 12
RowKeyDate = 1
RowKeyName = 4
RowKeyPcs = 10
RowKeyLock = 12
'Schließzylinder
RowCyl = 15
ColCylDoorNo = 2
ColCylName = 3
ColCylType = 4
ColCylSizeA = 5
ColCylSizeI = 6
ColCylLock = 7
ColCylStore = 8
ColCylDate = 10
'Schließmatrix
ColKeyDate = 12
RowKeyDate = 1
ColCylDate = 10
RowCylDate = 15
'Schlüssel
'Suche in Zeile "Datum" die letzte gefüllte Zelle
LastColKey = wb.Sheets("Matrix").Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Schleife für alle Schlüssel mit einem Datum und sperre die Zelle
For KCol = ColKey To LastColKey
wb.Sheets("Matrix").Cells(RowKeyDate, KCol).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyName, KCol).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyPcs, KCol).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(RowKeyLock, KCol).MergeArea.Locked = True
Next KCol
'Zylinder
'Suche in Spalte "Datum" die letzte gefüllte Zelle
LastRowCyl = wb.Sheets("Matrix").Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle Schließzylinder mit einem Datum und sperre die Zelle
For CRow = RowCyl To LastRowCyl
wb.Sheets("Matrix").Cells(ColCylDoorNo, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylName, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylType, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylSizeA, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylSizeI, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylLock, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylStore, CRow).MergeArea.Locked = True
wb.Sheets("Matrix").Cells(ColCylDate, CRow).MergeArea.Locked = True
Next CRow
'Schließung
'Suche in Zeile "Datum":Schlüssel die letzte gefüllte Zelle
LastColKey = wb.Sheets("Matrix").Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Suche in Zeile "Datum":Schließzylinder die letzte gefüllte Zelle
LastRowCyl = wb.Sheets("Matrix").Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle gefundenen Zellen in Matrix und sperre die Zellen
'Finde Zeile
For MCol = ColKeyDate To LastColKey
'Finde Spalte
For MRow = RowCylDate To LastRowCyl
'Sperre die gefundene Zelle
wb.Sheets("Matrix").Cells(MRow, MCol).Locked = True
Next MRow
Next MCol
End Sub
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo,
der Code muss halt zum Blatt passen oder umgekehrt oder so ...
Gruß Uwe
Registriert seit: 20.06.2021
Version(en): 2019
Es hat sich ein Leichtsinnsfehler eingeschlichen...
Hier jetzt der funktionierende Code:
Code: Sub ProtectKey()
'Workbook
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Matrix As Worksheet
Set Matrix = ThisWorkbook.Worksheets("Matrix")
'Positionen
Dim ColKey As Integer
Dim LastColKey As Integer
Dim RowKeyDate As Long
Dim RowKeyName As Long
Dim RowKeyPcs As Long
Dim RowKeyLock As Long
Dim RowCyl As Long
Dim LastRowCyl As Long
Dim ColCylDoorNo As Integer
Dim ColCylName As Integer
Dim ColCylType As Integer
Dim ColCylSizeA As Integer
Dim ColCylSizeI As Integer
Dim ColCylLock As Integer
Dim ColCylStore As Integer
Dim ColCylDate As Integer
Dim RowCylDate As Long
Dim ColKeyDate As Integer
'For-Schleifen
Dim KCol As Integer
Dim CRow As Long
Dim MCol As Integer
Dim MRow As Long
'Variablen
'Schlüssel
ColKey = 12
RowKeyDate = 1
RowKeyName = 4
RowKeyPcs = 10
RowKeyLock = 12
'Schließzylinder
RowCyl = 15
ColCylDoorNo = 2
ColCylName = 3
ColCylType = 4
ColCylSizeA = 5
ColCylSizeI = 6
ColCylLock = 7
ColCylStore = 8
ColCylDate = 10
'Schließmatrix
ColKeyDate = 12
RowKeyDate = 1
ColCylDate = 10
RowCylDate = 15
'Schlüssel
'Suche in Zeile "Datum" die letzte gefüllte Zelle
LastColKey = Matrix.Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Schleife für alle Schlüssel mit einem Datum und sperre die Zelle
For KCol = ColKey To LastColKey
Matrix.Cells(RowKeyDate, KCol).MergeArea.Locked = True
Matrix.Cells(RowKeyName, KCol).MergeArea.Locked = True
Matrix.Cells(RowKeyPcs, KCol).MergeArea.Locked = True
Matrix.Cells(RowKeyLock, KCol).MergeArea.Locked = True
Next KCol
'Zylinder
'Suche in Spalte "Datum" die letzte gefüllte Zelle
LastRowCyl = Matrix.Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle Schließzylinder mit einem Datum und sperre die Zelle
For CRow = RowCyl To LastRowCyl
Matrix.Cells(CRow, ColCylDoorNo).Locked = True
Matrix.Cells(CRow, ColCylName).Locked = True
Matrix.Cells(CRow, ColCylType).Locked = True
Matrix.Cells(CRow, ColCylSizeA).Locked = True
Matrix.Cells(CRow, ColCylSizeI).Locked = True
Matrix.Cells(CRow, ColCylLock).Locked = True
Matrix.Cells(CRow, ColCylStore).MergeArea.Locked = True
Matrix.Cells(CRow, ColCylDate).Locked = True
Next CRow
'Schließung
'Suche in Zeile "Datum":Schlüssel die letzte gefüllte Zelle
LastColKey = Matrix.Cells(RowKeyDate, Columns.Count).End(xlToLeft).Column
'Suche in Zeile "Datum":Schließzylinder die letzte gefüllte Zelle
LastRowCyl = Matrix.Cells(Rows.Count, ColCylDate).End(xlUp).Row
'Schleife für alle gefundenen Zellen in Matrix und sperre die Zellen
'Finde Zeile
For MCol = ColKeyDate To LastColKey
'Finde Spalte
For MRow = RowCylDate To LastRowCyl
'Sperre die gefundene Zelle
Matrix.Cells(MRow, MCol).Locked = True
Next MRow
Next MCol
End Sub
Vielen Dank für eure Hilfe!
|