Microsoft Excel

Herbers Excel/VBA-Archiv

Stapelspeicher | Herbers Excel-Forum


Betrifft: Stapelspeicher von: Knatterkopf
Geschrieben am: 22.02.2012 15:21:26

Hallo werte Kenner,

ich habe da ein Problem mit dem Stapelspeicher. Habe mir auch alles dazu im Forum (links) durchgelesen.
Ich muss irgend etwas übersehen haben, weil an einer Endlos-Schleife oder zu vielen gleichzeitigen Funktionsaufrufen kann es nicht nicht liegen.

Es sind doch nur 2 Funktionen, die auch nicht gleichzeitig ausgeführt werden. Die Schleifen sind auch endlich. Insgesamt sind es 3 Aufrufe. Vll? in einer unpassenden Reihenfolge?

Ein Kollege hat mich gebeten, einige Zellen automatisch zusammen zu fassen.
Ich weiß, dass .merge nicht die feine englische Art ist.

Bin um eine Erklärung bzw. Hilfe sehr dankbar!
Viele Grüße
Adrian

Hier mal der Code:

Dim Cind As Integer, Cell As Range, StartCol As Integer

Private Sub Worksheet_Change(ByVal target As Range)
Dim rgnDate As Range, iCalc As Long
With Application
    'iCalc = .Calculation
    '.ScreenUpdating = False
    '.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    DateMerge Range("B11:AR11"), -4
    KWMerge Range("B12:AR12")
    DateMerge Range("B25:AR25"), -2
    Application.DisplayAlerts = True
    '.Calculation = iCalc
    '.ScreenUpdating = True
End With
End Sub
Private Function DateMerge(CtrRng As Range, off As Integer)
Dim StrDate1 As String, StrDate2 As String
CtrRng.UnMerge
For Each Cell In CtrRng
    Cell.Value = Cell.Offset(off, 0).Value
Next
StartCol = CtrRng.Column
For Each Cell In CtrRng
    StrDate1 = Month(Cell.Value)
    StrDate2 = Month(Cell.Offset(0, 1))
    If Not StrDate1 = StrDate2 Then
        Cind = Cell.Column
        Range(Cells(CtrRng.Row, StartCol), Cells(CtrRng.Row, Cind)).Merge
        StartCol = Cell.Offset(0, 1).Column
    End If
Next
End Function
Private Function KWMerge(KWRng As Range)
Dim KW1 As String, KW2 As String
KWRng.UnMerge
For Each Cell In KWRng
    Cell.Value = Cell.Offset(-2, 0).Value
Next
StartCol = KWRng.Column
For Each Cell In KWRng
    KW1 = Cell.Value
    KW2 = Cell.Offset(0, 1)
    If Not KW1 = KW2 Then
        Cind = Cell.Column
        Range(Cells(KWRng.Row, StartCol), Cells(KWRng.Row, Cind)).Merge
        StartCol = Cell.Offset(0, 1).Column
    End If
Next
End Function

  

Betrifft: AW: Stapelspeicher von: Rudi Maintaire
Geschrieben am: 22.02.2012 15:43:12

Hallo,
Worksheet_Change wird durch die Functions immer wieder aufgerufen.
Schalte die Events aus.

Gruß
Rudi


  

Betrifft: AW: Stapelspeicher von: Knatterkopf
Geschrieben am: 24.02.2012 10:38:36

Danke Rudi, das half ;)

Lg
Adrian