Clever-Excel-Forum

Hi,

ich habe in einem Zellbereich (B4:CW103) einer Hilfstabelle entweder eine 0 oder eine Zahl.
Im Controlling-Blatt steht in manchen Zellen ein Datum, alle anderen sind Leerzellen.
Nun sollen im Controlling-Blatt die Leerzellen entweder mit einem "-" gefüllt werden oder leer bleiben, abhängig von der korrespondierenden Zelle der Hilfstabelle.

Mit

Code:
  With Sheets("Controlling")

      .Unprotect 'Passwort

      'Übertragen der Inhalte der Hilfstabelle

      For j = 2 To 101                             '100 Spalten: B bis CW

         For i = loMatrixStart To loMatrixEnde     '100 Zeilen: 4 bis 103

            'wenn im Controlling-Blatt ein Datum steht, soll das Datum bleiben

            If Not IsDate(Sheets("Controlling").Cells(i, j)) Then

               'wenn eine Zahl in der Hilfstabelle steht, soll die Zahl übertragen werden, bei 0 ein "-"

               If Sheets("Hilfstabelle").Cells(i, j).Value > 0 Then

                  .Cells(i, j).Value = .Cells(i, j).Value

               Else

                  .Cells(i, j).Value = "-"

               End If

            End If

         Next i

      Next j

      .Protect 'Passwort

   End With

geht es, dauert aber lange.

Wie kann ich das beschleunigen?

Mit

Code:
     Range("B4:CW103").SpecialCells(xlCellTypeBlanks) = 0

      .Range("B4:CW103").SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents

kann ich sehr schnell in alle leeren Zellen eine 0 schreiben oder Zellen mit "-" leer machen, gibt es so etwas auch für alle Zellen, die kein Datum enthalten?

Hallo Ralf
Dein Problem habe ich nur soweit verstanden, als es schnell gehen soll. Was immer das heisst: In der Ewigkeit wird das Zeitalter "Mensch" auch schnell sein. Aber hier habe ich einen Code gefunden (den ich natürlich nicht getestet habe und der zurechtgestutzt werden muss für Dein Problem): Man schreibt da von 10'000 in weniger als 1 sec
'''www.ms-office-forum.net/forum/showthread.php?t=296305

Code:
Sub KundeBox()

Dim objArrLst

Dim arrKunde() As Variant

Dim L As Long

Dim scrDic, TempArr

Dim wksD As Worksheet

Dim letzte As String, strTmp As String

Dim c As Integer, i As Integer

Const Trenner As String = "#"

Set wksD = ThisWorkbook.Worksheets("Datenbank")

Set scrDic = CreateObject("Scripting.dictionary")

letzte = wksD.Cells(Rows.Count, "B").End(xlUp).Row

arrKunde = wksD.Range("A2:C" & letzte)

    For L = 1 To UBound(arrKunde)

        strTmp = ""

        For i = 1 To UBound(arrKunde, 2)

            strTmp = strTmp & arrKunde(L, i) & Trenner

        Next

        If UCase(arrKunde(L, 1)) = "X" Then

            scrDic(strTmp) = 0

        End If

    Next

   TempArr = scrDic.keys

Erase arrKunde

'Größe des arrays Kunde setzen

ReDim Preserve arrKunde(scrDic.Count - 1, 1)

For L = 0 To scrDic.Count - 1

    arrKunde(L, 1) = Split(TempArr(L), Trenner)(1)

    arrKunde(L, 0) = Split(TempArr(L), Trenner)(2)

Next

Set scrDic = Nothing

QuickSortMultiDim arrKunde, 2 '***Modul aufrufen um nach Namen zu sortieren

    With Me.Kunde

        .ColumnCount = 2

        .ColumnWidths = "4cm;1cm"

        .List = arrKunde

    End With

End Sub

Rabe

Helvetier