Bereichsformatierung in einer Variablen speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
ich weiß noch immer nicht, was du eigentlich bezweckst, aber vielleicht hilft dir diese meine Antwort von vorgestern weiter:
Option Base 1
Sub machs()
Dim rngSelection As Range
Set rngSelection = Range(inv_Range(Selection))
rngSelection.Select
End Sub


Private Function inv_Range(rngS As Range)
On Error Resume Next
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim c As Long, rc As Long, cc As Integer
rc = ActiveSheet.Rows.Count
cc = ActiveSheet.Columns.Count
c = 0
If rngS.Row > 1 Then
Set rng1 = Rows("1:" & rngS.Row - 1)
c = 1
End If
If rngS.Row + rngS.Rows.Count - 1 < rc Then
Set rng2 = Rows(rngS.Row + rngS.Rows.Count & ":" & rc)
c = c + 2
End If
If rngS.Column > 1 Then
Set rng3 = Range(Columns(1), Columns(rngS.Column - 1))
c = c + 4
End If
If rngS.Column + rngS.Columns.Count - 1 < cc Then
Set rng4 = Range(Columns(rngS.Column + _
rngS.Columns.Count), Columns(cc))
c = c + 8
End If
inv_Range = ""
Do While c > 0
Select Case c
Case 1, 3, 5, 7, 9, 11, 13, 15:
If inv_Range = "" Then
inv_Range = rng1.Address
Else
inv_Range = Union(Range(inv_Range), rng1).Address
End If
c = c - 1
Case 2, 6, 10, 14:
If inv_Range = "" Then
inv_Range = rng2.Address
Else
inv_Range = Union(Range(inv_Range), rng2).Address
End If
c = c - 2
Case 4, 12:
If inv_Range = "" Then
inv_Range = rng3.Address
Else
inv_Range = Union(Range(inv_Range), rng3).Address
End If
c = c - 4
Case 8:
If inv_Range = "" Then
inv_Range = rng4.Address
Else
inv_Range = Union(Range(inv_Range), rng4).Address
End If
c = c - 8
End Select
Loop
End Function

Gruß K.Rola

Sub unusedrange_einfärben() Dim aws As Worksheet Dim ur As Range Dim ci As Integer Dim rngselection As Range Randomize ci = (Int((56 * Rnd) + 1)) Set aws = ActiveSheet Set ur = aws.UsedRange Set rngselection = Range(inv_Range(ur)) rngselection.Interior.ColorIndex = ci End Sub

Sub invselect() Dim x(4, 4) Dim BE(4) Dim a, b, c, d As Integer Dim i, j As Integer Dim rc, cc As Long Dim ur As Range rc = ActiveSheet.Rows.Count cc = ActiveSheet.Columns.Count Set ur = ActiveSheet.UsedRange a = ur.Row b = ur.Column c = ur.Rows.Count + a - 1 d = ur.Columns.Count + b - 1 x(1, 1) = 1 x(1, 2) = 1 x(1, 3) = a - 1 x(1, 4) = cc x(2, 1) = a x(2, 2) = 1 x(2, 3) = c x(2, 4) = b - 1 x(3, 1) = a x(3, 2) = d + 1 x(3, 3) = c x(3, 4) = cc x(4, 1) = c + 1 x(4, 2) = 1 x(4, 3) = rc x(4, 4) = cc For i = 1 To 2 If x(i, 3) = 0 Or x(i, 4) = 0 Then For j = 1 To 4 x(i, j) = x(4, j) Next End If Next For i = 1 To 4 Set BE(i) = Range(Cells(x(i, 1), x(i, 2)), Cells(x(i, 3), x(i, 4))) Next Union(BE(1), BE(2), BE(3), BE(4)).Select End Sub

Beliebteste Forumthreads (12 Monate)

Bereichsformatierung in einer Variablen speichern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread