An alle Interessierten,da ich mich weiter mit Zellverbindungen in zig älteren Tabellen rumschlagen muß, habe ich jetzt doch mal versucht, was zu basteln, mit Teilerfolg. Der folgende Code löscht eine Spalte oder fügt eine ein, auch wenn in den ersten 4 Zeilen Zellverbindungen sind. Funktioniert leider nur bei horizontalen Verbindungen. Bei vertikalen Verbindungen gibt es Chaos.
Sub SpalteLöschen()
Call SpEinfügenLöschen(-1)
End Sub
Sub SpalteEinfügen()
Call SpEinfügenLöschen(1)
End Sub
Private Sub SpEinfügenLöschen(ByVal x%) 'x=1=einfügen,-1=löschen
Dim n%, Ze%, Sp%, vb(4, 2) As Integer, rng$, vSp%, bSp%
Sp = ActiveCell.Column: Ze = ActiveCell.Row
For n = 1 To 4
Cells(n, Sp).Select
rng = Selection.Address
If Selection.MergeCells = True Then
Selection.MergeCells = False: vb(n, 0) = 1
Call Zellverbindung(rng, vSp, bSp)
vb(n, 1) = vSp: vb(n, 2) = bSp
End If
Next
If x = 1 Then Columns(Sp).Select: Selection.Insert Shift:=xlToRight
If x = -1 Then Columns(Sp).Select: Selection.Delete Shift:=xlToLeft
For n = 1 To 4
If vb(n, 0) = 1 Then
Range(SpBu(vb(n, 1)) & n & ":" & SpBu(vb(n, 2) + x) & n).Select
Selection.MergeCells = True
End If
Next
Cells(Ze, Sp).Select
End Sub
Private Sub Zellverbindung(ByVal A$, vSp%, bSp%) ' von-bis Spalte ermitteln
Dim s%, s1%, E$
s = InStr(A, ":"): E = Mid(A, 2, s - 2): s1 = InStr(E, "$")
vSp = SpNr(Left(E, s1 - 1)): E = Mid(A, s + 2)
s1 = InStr(E, "$"): bSp = SpNr(Left(E, s1 - 1))
End Sub
Function SpBu(ByVal n As Integer) As String ' wandelt Spaltenzahl(n)= 27 in AA um
Dim s As Integer, s1 As Integer
If n < 27 Then
SpBu = Trim(Chr(n + 64))
Else
s = (n - 1) \ 26: s1 = (n - 1) Mod 26 + 1
SpBu = Trim(Chr(s + 64)) & Trim(Chr(s1 + 64))
End If
End Function
Function SpNr(AB22 As String) As Integer 'gibt für Spalte AB oder Adresse AB22 die Nr. 28 zurück
Dim s, r, n As Integer, Sp As String
Sp = Trim(UCase(AB22))
m1:
If Len(Sp) = 1 Then
SpNr = Asc(Sp) - 64
Else
s = Asc(Sp) - 64
If n = 0 Then
For r = 2 To Len(Sp)
If Asc(Mid(Sp, r, 1)) < 65 Then
Sp = Left(Sp, r - 1): n = 1
GoTo m1
End If
Next
End If
SpNr = s * 26 + Asc(Right(Sp, 1)) - 64
End If
End Function
Grüsse
Peter