Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1660to1664
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Immer noch kommt hin und wieder ein Fehler

Immer noch kommt hin und wieder ein Fehler
04.12.2018 11:45:00
Stefan
Ich habe dank eurer Hilfe hier ein Ereignis, welches mir in bestimmten Zellbereichen meine leeren Zeilen ausblendet. Das klappt meistens auch ganz gut. Allerdings kommt es hin und wieder zu einem Fehler im Range (Wird gelb dort markiert) und ich weiss einfach nicht warum. Wenn ich nur einen Bereich eingebe (B14:B20 zb) dann kommt nie ein Fehler.
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
'Ausblenden bzw Zeilenhöhe minimal einstellen von Zeilen, die nicht verwendet werden
Dim Zelle As Range
ActiveSheet.Unprotect Password:="mueller"
With Application
.Calculation = xlCalculationManual
For Each Zelle In Range("B15:B22,B24:B31,B33:B40,B42:B49,B51:B58,B60:B67").Cells
Zelle.EntireRow.RowHeight = 0.5 - 14.5 * (Zelle > 0)
Next Zelle
.Calculation = xlAutomatic
End With
ActiveSheet.Protect AllowInsertingHyperlinks:=True, userinterfaceonly:=True, AllowSorting:= _
False, DrawingObjects:=True, AllowFiltering:=False, Contents:=True, Password:="mueller"
ActiveSheet.EnableOutlining = True
Set Zelle = Nothing
Application.ScreenUpdating = True
End Sub

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Immer noch kommt hin und wieder ein Fehler
04.12.2018 12:34:13
Luschi
Hallo Stefan,
genau das ist ein altes Kriegsleiden von Excel, wenn es zu viele Einzelbereiche gibt,
deshalb löse ich das Problem so:

Dim zelle As Range, rgBer As Range, vArr As Variant, sBer As String, i As Integer
'Berreich als Text festlegen
sBer = "B15:B22,B24:B31,B33:B40,B42:B49,B51:B58,B60:B67"
'Array erstellen
vArr = Split(sBer, ",", -1, vbTextCompare)
'jeden Arraywert zu einem Range-Bereich zusammenbauen
For i = LBound(vArr) To UBound(vArr)
If rgBer Is Nothing Then
Set rgBer = Range(vArr(i))
Else
Set rgBer = Union(rgBer, Range(vArr(i)))
End If
Next i
Debug.Print rgBer.Address
For Each zelle In rgBer.Cells
zelle.EntireRow.RowHeight = 0.5 - 14.5 * (zelle > 0)
Next zelle
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Immer noch kommt hin und wieder ein Fehler
04.12.2018 13:33:13
Sven
Hey Luschi,
deinen code probiere ich auch mal. Scheint bislang zu keinen Fehlern zu kommen. Allerdings ist der nicht so "zackig", wie der von mir. Funktioniert allerdings ....bislang ;)
Merci erstmal ;)
AW: Immer noch kommt hin und wieder ein Fehler
04.12.2018 16:16:31
Luschi
Hallo Sven/Stefan,
was nützt der zackigste Vba-Code, wenn er immer wieder mal einem Aussetzer aus unersichtlichen Gründen produziert. Bin gerade vorige Woche in Excel 2013/19 darüber gestolert - deshalb der kleine Umweg üver Array/Split und Union, und sollte es kein erkennbares Blockmuster geben für 'Step', bleibt einem wohl nicht anderes übrig.
Gruß von Luschi
aus klein-Paris
Anzeige
2 Bereiche hinzugefügt-kein Fehler bei mir- oT
04.12.2018 12:47:09
robert
anderer Ansatz
04.12.2018 13:06:40
Rudi
Hallo,
    Dim i As Integer, zelle As Range
For i = 15 To 60 Step 9
For Each zelle In Cells(i, 2).Resize(8)
zelle.EntireRow.RowHeight = 0.5 - 14.5 * (zelle > 0)
Next zelle
Next i

Gruß
Rudi
AW: anderer Ansatz
04.12.2018 13:26:19
Sven
Rudi, ich benötige eben genau diese Bereiche, da ich nicht möchte, dass die anderen Zeilen, die in meinem Bereich ausgespart sind und in denen in der zelle auch nichts drinnen steht, nicht in ihrer Höhe verändert werden.
Der Fehler tritt ja auch nicht immer auf. Nur manchmal.. und genau dann, bringt er den Fehler immer genau am gleichen Fleck.
Anzeige
mein Code durchläuft ....
04.12.2018 13:53:57
Rudi
.... exakt die von dir angegebenen Bereiche
AW: mein Code durchläuft ....
04.12.2018 16:11:07
Luschi
Hallo Rudi,
Dein Ansatz ist für diesen Zweck passend, da immer die selbe Blockgröße. Ist das aber nicht gegeben,
dann gibt es leider Probleme (auch in Excel 2019) mit der Variant Range("B15:B22,K14:F31,...".
Wie der Fragesteller es schon bemerkte. mal läuft's und auch mal wieder nicht; einfach total unbefriedigend. Deshalb mein Umweg über Array und Union.
Gruß von Luschi
aus klein-Paris
AW: mein Code durchläuft ....
04.12.2018 16:46:47
Rudi
Hallo,
ein Ansatz für unregelmäßige Blöcke/ Abstände:
Sub aaaa()
Dim arrRow, arrLen, i As Integer, rCell As Range
arrRow = Array(15, 24, 36, 45)
arrLen = Array(6, 9, 7, 8)
For i = LBound(arrRow) To UBound(arrRow)
For Each rCell In Cells(arrRow, 2).Resize(arrLen)
'mach was
Next rCell
Next i
End Sub

Gruß
Rudi
Anzeige
AW: anderer Ansatz
04.12.2018 14:05:05
Sven
Rudi das stimmt, habe ich überlesen den Step - Der Code läuft - und noch dazu schnell ! Danke

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige