Verbundene Zellen sperren

[tomcat]

Ok jetzt komme ich mit.

Sollte ich jetzt aber die Verbundenen Zellen auflösen sollte es ja kein Problem mehr geben richtig?

[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.

[{Boris}]

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?

[tomcat]

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

[Kuwer]

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

[tomcat]

Hi Uwe,

DU BIST MEIN RETTER!!!!!!

Vielen Dank es funktioniert.

[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

[Kuwer]

Hallo,

der Code muss halt zum Blatt passen oder umgekehrt oder so ...

Gruß Uwe

[tomcat]

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!