Microsoft Excel

Herbers Excel/VBA-Archiv

Immer noch kommt hin und wieder ein Fehler


Betrifft: Immer noch kommt hin und wieder ein Fehler
von: Stefan
Geschrieben am: 04.12.2018 11:45:00

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

  

Betrifft: AW: Immer noch kommt hin und wieder ein Fehler
von: Luschi
Geschrieben am: 04.12.2018 12:34:13

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


  

Betrifft: AW: Immer noch kommt hin und wieder ein Fehler
von: Sven
Geschrieben am: 04.12.2018 13:33:13

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 ;)


  

Betrifft: AW: Immer noch kommt hin und wieder ein Fehler
von: Luschi
Geschrieben am: 04.12.2018 16:16:31

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


  

Betrifft: 2 Bereiche hinzugefügt-kein Fehler bei mir- oT
von: robert
Geschrieben am: 04.12.2018 12:47:09




  

Betrifft: anderer Ansatz
von: Rudi Maintaire
Geschrieben am: 04.12.2018 13:06:40

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


  

Betrifft: AW: anderer Ansatz
von: Sven
Geschrieben am: 04.12.2018 13:26:19

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.


  

Betrifft: mein Code durchläuft ....
von: Rudi Maintaire
Geschrieben am: 04.12.2018 13:53:57

.... exakt die von dir angegebenen Bereiche


  

Betrifft: AW: mein Code durchläuft ....
von: Luschi
Geschrieben am: 04.12.2018 16:11:07

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


  

Betrifft: AW: mein Code durchläuft ....
von: Rudi Maintaire
Geschrieben am: 04.12.2018 16:46:47

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


  

Betrifft: AW: anderer Ansatz
von: Sven
Geschrieben am: 04.12.2018 14:05:05

Rudi das stimmt, habe ich überlesen den Step - Der Code läuft - und noch dazu schnell ! Danke