21.01.2022, 11:43
Seiten: 1 2
21.01.2022, 11:48
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.
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.
21.01.2022, 11:52
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?
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?
21.01.2022, 12:27
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
Ich werde jetzt mal die Verbundenen Zellen lösen und mein Arbeitsblatt anpassen.
Ich melde mich sobald ich fertig bin
21.01.2022, 13:13
Hallo Tom,
teste es mal so:
Gruß Uwe
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
21.01.2022, 15:04
Hi Uwe,
DU BIST MEIN RETTER!!!!!!
Vielen Dank es funktioniert.
DU BIST MEIN RETTER!!!!!!
Vielen Dank es funktioniert.
21.01.2022, 19:05
Hi ich nochmals,
hier der Code:
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!
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
21.01.2022, 20:32
Hallo,
der Code muss halt zum Blatt passen oder umgekehrt oder so ...
Gruß Uwe
der Code muss halt zum Blatt passen oder umgekehrt oder so ...
Gruß Uwe
21.01.2022, 22:17
Es hat sich ein Leichtsinnsfehler eingeschlichen...
Hier jetzt der funktionierende Code:
Vielen Dank für eure Hilfe!
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!
Seiten: 1 2