Formeln in Zellen durch VBA ersetzen

Hallo, liebe Excel-Freunde ich habe folgendes Problem:
Mittels VBA setzte ich durch Doppelclick ein X in bestimmte Zellen. Diese Zellen werden
ausgelesen und für nachfolgende Formel benötigt:
{=WENN(ZEILE()>ZÄHLENWENN(Tabelle1!A:A;"WAHR");"";INDEX(Tabelle1!B:B; KKLEINSTE(WENN(Tabelle1!A:A; ZEILE($1:$300));ZEILE()))) }
Diese Formel habe ich in insgesamt 300 Zellen einer Spalte kopiert. Das hat zur Folge, dass jetzt
offensichtlich die Rechenleistung so beansprucht wird, dass es bei jedem Doppelclick ca. 3 Sekunden dauert, bis das X gesetzt ist.
Meine Frage nun: Kann man das mit VBA besser lösen, hilft es bei der Arbeitsgeschwindigkeit und wenn ja, wie lautet dann die VBA-Lösung ?
Vielen Dank schon jetzt
Gruss Mario

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Mario,
ersetze den Code durch den folgenden.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim vntValues As Variant, vntResult As Variant
  Dim lngIndex As Long, lngMax As Long, lngC As Long, lngNext As Long, lngCol As Long

  lngNext = 1

  With Target
    Select Case .Column
      Case 5, 10, 15, 20, 25, 30
        Cancel = True
        Sheets("Druckliste").Columns(2) = ""
        If .Value <> "" Then .Offset(0, 2) = IIf(LCase(Target.Offset(0, 2)) <> "x", "X", "")
        For lngCol = 5 To 30 Step 5
          vntValues = Range(Cells(3, lngCol), Cells(48, lngCol + 2))
          lngMax = Application.CountIf(Range(Cells(3, lngCol + 2), Cells(48, lngCol + 2)), "X")
          If lngMax > 0 Then
            Redim vntResult(1 To lngMax, 1 To 1)
            lngC = 0
            For lngIndex = 1 To UBound(vntValues, 1)
              If vntValues(lngIndex, 1) <> "" And vntValues(lngIndex, 3) = "X" Then
                lngC = lngC + 1
                vntResult(lngC, 1) = vntValues(lngIndex, 1)
              End If
            Next
            Sheets("Druckliste").Cells(lngNext, 2).Resize(lngMax, 1) = vntResult
            lngNext = lngNext + lngMax
          End If
        Next
      Case Else
    End Select
  End With

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Formeln in Zellen durch VBA ersetzen

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

388 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formeln in Zellen durch VBA ersetzen

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

388 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread