Clever-Excel-Forum

Seiten: 1 2

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("B5,H5,E5,P5,S5,V5,B7,H7,E7,P7,S7,V7,B9,H9,E9,P9,S9,V9,B11,H11,E11,P11,S11,V11,B13,H13,E13,P13,S13,V13,B15,H15,E15,P15,S15,V15,B17,H17,E17,P17,S17,V17,B19,H19,E19,P19,S19,V19,B21,H21,E21,P21,S21,V21,B23,H23,E23,P23,S23,V23,M4:M23,AA4:AA23")) Is Nothing Then Exit Sub

If Len(Target.Cells(1)) = 0 Then

Target.Cells(1) = "X"

Else

Target.Cells(1) = vbNullString

End If

Cancel = True

End Sub

Hallo, habe eine Sub, die in gewissen Zellen ein x erzeugt. Das klappt soweit. Aber nur bis zu einer maximalen Anzahl an Zellen. Sobald ich jetzt eine Zelle mehr einfüge, kommt ein Laufzeitfehler 1004. Habe aber leider noch fast doppelt so viele Zellen, die er ansprechen muss.

Moin!
Die Spalten stehen ja fest (leider ohne Algorithmus, den man zugrundelegen könnte)
Spaltennummern: 2, 5, 8, 16, 19, 22
Ab Zeile 5 geht es dann in 2er-Schritten weiter, also die ungeraden Zeilen.
Dies könntest Du in einer geschachtelten Select-Case-Abfrage kürzen.

Gruß Ralf

Hi,

der Spaltenalgorithmus ist doch der:
n*14+m*3+2

für n=0 bis 1
und m=0 bis 2

Code:
=(2+((SPALTE(A1)-1)*3))+5*GANZZAHL((SPALTE(A1))/4)

Liefert 2; 5; 8; 16; 19; 22 'In VB Spalte durch Variable ersetzen und Ganzzahl (Int oder Fix)

Edit:
Opa Edgar war schneller und mal wieder kurz und knackig.

Code:
.Range("B5,H5,E5,P5,S5,V5,B7,H7,E7,P7,S7,V7,B9,H9,E9,P9,S9,V9,B11,H11,E11,P11,S11,V11,B13,H13,E13,P13,S13,V13,B15,H15,E15,P15,S15,V15,B17,H17,E17,P17,S17,V17,B19,H19,E19,P19,S19,V19,B21,H21,E21,P21,S21,V21,B23,H23,E23,P23,S23,V23,M4:M23,AA4:AA23"))

.Range("B5,H5,E5,P5,S5,V5,B7,H7,E7,P7,S7,V7,B9,H9,E9,P9,S9,V9,B11,H11,E11,P11,S11,V11,B13,H13,E13,P13,S13,V13,B15,H15,E15,P15,S15,V15,B17,H17,E17,P17,S17,V17,B19,H19,E19,P19,S19,V19,B21,H21,E21,P21,S21,V21,B23,H23,E23,P23,S23,V23,B26,H26,E26,P26,S26,V26,B28,H28,E28,P28,S28,V28,B30,H30,E30,P30,S30,V30,B32,H32,E32,P32,S32,V32,B34,H34,E34,M4:M23,M25:M34,AA4:AA23,AA25:AA32"))

.Range("C5:D5,F5:G5,I5:J5,C7:D7,F7:G7,I7:J7,C9:D9,F9:G9,I9:J9,C11:D11,F11:G11,I11:J11,C13:D13,F13:G13,I13:J13,C15:D15,F15:G15,I15:J15,C17:D17,F17:G17,I17:J17,C19:D19,F19:G19,I19:J19,C21:D21,F21:G21,I21:J21,C23:D23,F23:G23,I23:J23,Q5:R5,T5:U5,W5:X5,Q7:R7,T7:U7,W7:X7,Q9:R9,T9:U9,W9:X9,Q11:R11,T11:U11,W11:X11,Q13:R13,T13:U13,W13:X13,Q15:R15,T15:U15,W15:X15,Q17:R17,T17:U17,W17:X17,Q19:R19,T19:U19,W19:X19,Q21:R21,T21:U21,W21:X21,Q23:R23,T23:U23,W23:X23"))

Range.("C5:D5,F5:G5,I5:J5,C7:D7,F7:G7,I7:J7,C9:D9,F9:G9,I9:J9,C11:D11,F11:G11,I11:J11,C13:D13,F13:G13,I13:J13,C15:D15,F15:G15,I15:J15,C17:D17,F17:G17,I17:J17,C19:D19,F19:G19,I19:J19,C21:D21,F21:G21,I21:J21,C23:D23,F23:G23,I23:J23,Q5:R5,T5:U5,W5:X5,Q7:R7,T7:U7,W7:X7,Q9:R9,T9:U9,W9:X9,Q11:R11,T11:U11,W11:X11,Q13:R13,T13:U13,W13:X13,Q15:R15,T15:U15,W15:X15,Q17:R17,T17:U17,W17:X17,Q19:R19,T19:U19,W19:X19,Q21:R21,T21:U21,W21:X21,Q23:R23,T23:U23,W23:X23,Q26:R26,T26:U26,W26:X26,Q28:R28,T28:U28,W28:X28,Q30:R30,T30:U30,W30:X30,Q32:R32,T32:U32,W32:X32,C26:D26,F26:G26,I26:J26,C28:D28,F28:G28,I28:J28,C30:D30,F30:G30,I30:J30,C32:D32,F32:G32,I32:J32,C34:D34,F34:G34,I34:J34"))

Also eine Variable für die Spalten einsetzen?
Habe 4 verschiedene subs mit jeweils anderen Ranges, die zu lang sind.
Echt knifflig.

Zunächst mal :18: für Bosko und Elex!
@Barthi:
Warum gibt es überhaupt die "zerpflückten" Bereiche?

Anders herum:
Wäre es nicht sinnvoller, bei allen Zellen, bei denen das x geswitcht werden soll, unter Schutz geperrt zu entfernen.
Und dann einfach so:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Locked Then Exit Sub
Target = IIf(Len(Target.Cells), "", "X")
Cancel = True
End Sub

Gruß Ralf

Ich habe das mal für Deine Bereiche aus #1 umgesetzt.
Nur in den grünen Zellen führt der Doppelklick zum switchen.
Der Code ist tatsächlich ausschließlich der kurze aus meiner letzten Antwort.

Gruß Ralf

Ich werde aber mal das mühsame "Entsperren" durch ein Makro durchführen lassen.
Damit es sich auch lohnt, mal bis Zeile 123
Werde den Algorithmus von Edgar nehmen.
… to be continued …

And here it is:

Sub Sperre_entfernen()
  Dim z&, s&, n&, m&
  Application.ScreenUpdating = False
  Cells.ColumnWidth = 2
  For z = 5 To 123 Step 2
    For n = 0 To 1
      For m = 0 To 2
        s = n * 14 + m * 3 + 2
        With Cells(z, s)
          .Locked = False
          .Interior.Color = vbRed
          .HorizontalAlignment = xlCenter
          .Font.Color = vbWhite
          .Font.Bold = True
        End With
      Next
    Next
  Next
  With Range("M4:M123, AA4:AA123")
    .Locked = False
    .Interior.Color = vbRed
    .HorizontalAlignment = xlCenter
    .Font.Color = vbWhite
    .Font.Bold = True
  End With
End Sub

Eine gute Idee, allerdings sind viele Zellen bereits gesperrt, damit kein Fremder in bestimmte Zellen etwas eintragen kann.

Seiten: 1 2

barthi

RPP63

BoskoBiati

Elex

barthi

RPP63

RPP63

RPP63

RPP63

barthi