Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schnell sehr viele Formeln ins Blatt schreiben

Schnell sehr viele Formeln ins Blatt schreiben
Reinhard
Hallo Wissende,
die Datei: https://www.herber.de/bbs/user/75334.xlsm
hat nachfolgenden Code, gestartet mit dem Button Blatt1.
ES folgen jetzt Hintergrundinformationen, prinzipiell nicht so wichtig. Die konkrete Frage ist dann das nächste Fettgedruckte.

Ein Anfrager in einem anderen Forum will für jede Zelle im Blatt2 als Ergebnis stehen haben wie oft der analoge Wert in der gleichen Zelle in Blatt1 in Blatt1 vorkommt. Dafür zeigte er diese Formel:
=WENN('Blatt1'!A10;ZÄHLENWENN('^Blatt1'!$A$1:$ALL$1000;'Blatt1'!A1);"")
Nach Nachfrage was er denn mit "Excel nippelt ab" meint kam raus daß er da wohl in kleineren Bereichen manuell die Formel reinkopiert hat, da die zeit gemessen/geschätzt hat und kam auf 250 min für die 1 Mio Zellen.
Excel- oder Vbalösung ist egal.
Ich habe dann verschiedene Varianten durchgetestet.
Also mit
Bereich.Formula=Formel
Das dauerte mir zu lang.
Dann probierte ich es so:
Bereich.Value="#" & Formel
Dann wollte ich dann einfach die "#" durch Ersetzen weglöschen, klappte auch nicht.
Es tat sich schlichtweg nix obwohl es angeppasster aufgezeichneter Code war.
Und ich habe noch mehr probiert ... :-(
Das war jetzt nur zur Erhellung des Hintergrundes, jetzt meine konkrete Frage.
Ich möchte in einem Bereich in Blatt2 in jeder Zelle stehen haben wie oft der Wert des gleichen Zellennamens in Blatt1 in dem Blatt1 vorkommt.
Excel- oder Vbalösung ist egal, gesucht ist die schnellste Methode/Code.

Danke ^ Gruß
Reinhard

Option Explicit
Sub Zaehlen()
Dim Ber(1 To 1000, 1 To 1000) As String, a As Integer, b As Integer
Dim T As Single, Formel As String
T = Timer
Formel = "=IF(Tabelle1!RC0,COUNTIF(Tabelle1!R1C1:R1000C1000,Tabelle1!RC),"""")"
ActiveWorkbook.Names.Add Name:="XXX", RefersToR1C1:=Formel
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Worksheets("Tabelle2").UsedRange.ClearContents
For a = 1 To 1000
For b = 1 To 1000
Ber(a, b) = "=XXX"
Next b
Next a
Worksheets("Tabelle2").Range("A1:ALL1000") = Ber
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Timer - T
End Sub

AW: Schnell sehr viele Formeln ins Blatt schreiben
17.06.2011 20:05:52
ransi
HAllo
Bei sovielen Formeln kann Excel sich schonmal verschlucken.
Ich hab mal versucht anhand deiner Angaben eine Testtabelle mit Werten zu erstellen.
Versuch mal diesen Code:
Public Sub test()
    Dim arr
    Dim myDic As Object
    Dim out
    Dim L As Long
    Dim I As Integer
    Dim T As Double
    
    T = Timer
    Set myDic = CreateObject("Scripting.Dictionary")
    arr = Sheets("TAbelle1").Range("A1:ALL1000")
    
    For L = 1 To UBound(arr)
        For I = 1 To UBound(arr, 2)
            myDic(arr(L, I)) = myDic(arr(L, I)) + 1
        Next
    Next
    
    out = Sheets("TAbelle2").Range("A1:ALL1000")
    
    For L = 1 To UBound(out)
        For I = 1 To UBound(out, 2)
            out(L, I) = myDic(out(L, I))
        Next
    Next
    Sheets("TAbelle2").Range("A1:ALL1000") = out
    MsgBox Timer - T
End Sub



ransi
Anzeige
AW: Schnell sehr viele Formeln ins Blatt schreiben
17.06.2011 21:41:54
Reinhard
Hallo Ransi,
hab ich mich wiedermal mißverständlich ausgedrückt, sorry dafür.
Ich möchte/hätte gern die schnellste Methode um zu erreichen daß in
Tabelle2!A1 das Ergebnis steht von:
=Tabelle1!A1
Wobei jetzt =Tabelle1!A1 nur da steht um in Kurzform zu demonstrieren was ich möchte.
Wie beschriebn ist dann die wahre Formel in Tabelle2!A1
=Wenn(Zählenwenn...
Und das halt für paar viele Zellen mehr.
Danke ^ Gruß
Reinhard
AW: Schnell sehr viele Formeln ins Blatt schreiben
17.06.2011 20:23:47
Josef

Hallo Reinhard,
warum eine leere Tabelle? Von denen habe ich selber genug;-))
Rund 4 Min. bei 100.000 gefüllten Zellen, also wohl ca. 40 Min. bei 1000.000 gefülllten Zellen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub Zaehlen()
  Dim rng As Range
  Dim lngCol As Long, lngRow As Long
  Dim vntValues As Variant, vntRet() As Variant
  Dim t As Double
  t = Timer
  Set rng = Sheets("Tabelle1").Range("A1:ALL1000")
  vntValues = rng
  Redim vntRet(1 To UBound(vntValues, 1), 1 To UBound(vntValues, 2))
  For lngRow = 1 To UBound(vntValues, 1)
    For lngCol = 1 To UBound(vntValues, 2)
      If vntValues(lngRow, lngCol) <> Empty Then
        vntRet(lngRow, lngCol) = Application.CountIf(rng, vntValues(lngRow, lngCol))
      End If
    Next
  Next
  Sheets("Tabelle2").Range(rng.Address) = vntRet
  Debug.Print Timer - t
  Set rng = Nothing
End Sub


« Gruß Sepp »

Anzeige
AW: Schnell sehr viele Formeln ins Blatt schreiben
17.06.2011 22:05:16
Reinhard
Hallo Sepp,
warum eine leere Tabelle? Von denen habe ich selber genug;-))
okay, das nächste Mal erstelle ich die Beispielmappe mit 1 Mio gefüllten Zellen in Tabelle1 und lade sie woanders hoch.
Dann kriege ich aber von anderen hier Haue die mir sagen für die Formeleinfügung in Blatt2 kann Blatt1 auch leer sein...
Ein Teufelskreis :-)
Rund 4 Min. bei 100.000 gefüllten Zellen, also wohl ca. 40 Min. bei 1000.000 gefülllten Zellen.
Danke dir für das Füllen der 100.000 Zellen und dem Testen.
40 min? Oha.
Da probiere ich doch glatt, immerhin trägt mein Code die Funktion "=XXX" im 20 sec Bereich ein, diese dann innerhalb von 40 min umzuformen sodaß sie auch funktioniert.
Zur Not wie schon MVP bernd held es empfiehlt, Zelle für Zelle mit Sendkeys und F2 zu beglücken.
Danke ^ Gruß
Reinhard
Anzeige
AW: Schnell sehr viele Formeln ins Blatt schreiben
18.06.2011 11:08:32
ransi
HAllo Rheinhard
Zur Not wie schon MVP bernd held es empfiehlt, Zelle für Zelle mit Sendkeys und F2 zu beglücken.
Hm ?
Das interessiert mich doch sehr.
Wo kann man das denn nachlesen ?
ransi
OT
18.06.2011 12:13:49
Reinhard
Hallo Ransi,
BH war hier schon mehrfach Thema, bis hin bis er hier mitschrieb und mit Anwalt drohte wegen Verleumdung o.ä.
In solchen oft länger gewordenene Beitragsfolgen wie hier:
https://www.herber.de/forum/archiv/432to436/t435336.htm
Der dortige Code um Leerzeichen aus den zellen einer Spalte zu entfernen ist immer noch auf seiner Homepage.
Ein MVP sagte mir BH wäre kein MVP mehr. Naja, so Titel kommen und gehen :-)
Das mit Sendkeys und F2 steht in einem seiner Bücher aber da ich jetzt den dortigen Gesamtcode und die Aufgabe nicht kenne kann ich es nicht bewerten.
Jedenlfalls schicke ich nicht 1 Mio mal mit Sendkeys F2 in eine Zelle.
Gruß
Reinhard
Anzeige
AW: Schnell sehr viele Formeln ins Blatt schreiben
18.06.2011 11:35:47
Josef

Hallo Reinhard,
ich hab ja nicht geschrieben, das du eine Mappe mit 1.000.000 gefüllten Zellen hochladen sollst, aber statt einer Leeren Mappe hättest du auch nur den Code Posten können.
Ich verstehe dein Problem nicht, warum füllst du nicht einfach den Bereich mit der entsprechenden Formel.
Sheets("Tabelle2").Range("A1:ALL1000").Formula = "=IF(Tabelle1!A1="""","""",COUNTIF(Tabelle1!$A$1:$ALL$1000,Tabelle1!A1))"
Das Excel dabei abschmiert ist aber zu erwarten, aber wer braucht schon eine Tabelle mit 1.000.000 Formeln?

« Gruß Sepp »

Anzeige
AW: Schnell sehr viele Formeln ins Blatt schreiben
17.06.2011 23:01:06
Rudi
Hallo,
warum nicht einfach
Worksheets("Tabelle2").Range("A1:ALL1000").Formula = "=xxx"
?
Gruß
Rudi
Schnell viele Formeln ins Blatt schreiben
18.06.2011 11:02:04
Erich
Hi Reinhard,
Ransis Ansatz habe ich etwas umgestrickt und dann mit Sepps Lösung verglichen.
Zumindest in diesem Beispiel ist Ransis Methode viel schneller:

Sub A1test()
Dim arr, myDic As Object, out()
Dim L As Long, I As Integer, t As Double
t = Timer
Set myDic = CreateObject("Scripting.Dictionary")
arr = Sheets("Tabelle1").Range("A1:ALL1000")
For L = 1 To UBound(arr)
For I = 1 To UBound(arr, 2)
If Not IsEmpty(arr(L, I)) Then
myDic(arr(L, I)) = myDic(arr(L, I)) + 1
End If
Next
Next
ReDim out(1 To UBound(arr), 1 To UBound(arr, 2))
For L = 1 To UBound(arr)
For I = 1 To UBound(arr, 2)
out(L, I) = myDic(arr(L, I))
Next
Next
Sheets("Tabelle2").Range("A1:ALL1000") = out
Sheets("Tabelle1").Range("A1") = Timer - t
End Sub
Sub A2Zaehlen()
Dim rng As Range
Dim lngCol As Long, lngRow As Long
Dim vntValues As Variant, vntRet() As Variant
Dim t As Double
t = Timer
Set rng = Sheets("Tabelle1").Range("A1:ALL1000")
vntValues = rng
ReDim vntRet(1 To UBound(vntValues, 1), 1 To UBound(vntValues, 2))
For lngRow = 1 To UBound(vntValues, 1)
For lngCol = 1 To UBound(vntValues, 2)
If vntValues(lngRow, lngCol)  Empty Then
vntRet(lngRow, lngCol) = Application.CountIf(rng, vntValues(lngRow, lngCol))
End If
Next
Next
Sheets("Tabelle2").Range(rng.Address) = vntRet
Sheets("Tabelle1").Range("B1") = Timer - t
Set rng = Nothing
End Sub
Hier eine Beispielmappe (mit den Zeiten in Tab1!A1:B1): https://www.herber.de/bbs/user/75336.xlsm
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort und: Schönes Wochenende allerseits!
Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige