Microsoft Excel

Herbers Excel/VBA-Archiv

Formel in VBA darstellen

Betrifft: Formel in VBA darstellen von: Frank Berends
Geschrieben am: 02.10.2014 14:54:01

Hallo zusammen,

ich habe die folgende Formel in Excel stehen (mit Hilfe von eingen von Euch erstellt). Die Grundidee dazu ist folgende:

ich ziehe aus einer externen Quelle per Copy and Paste Daten in die Tabelle (also das, was Excel als Tabelle ansieht, nicht das Arbeitsblatt). Die Formel durchläuft eine Negativliste auf einem zweiten Arbeitsblatt(die Bereich, die hier mit Legende... angegeben sind). Es wird danach ausgewertet, ob es sich um wesentliche oder nicht wesentlich RS-Titel oder Bearbeitungsvermerke handelt.

Es kann dabei auch gerne mal sein, dass mehr als 100 Zeilen zusammenkommen. Und da beginnt bei mir ein Performance-Problem.

=WENN(ODER(D3="Einsteller";ANZAHL2(Tabelle2[[#Diese Zeile];[Datum]:[Sachgebiet]])=0);" ";

WENN(WENN(SUMME(ISTZAHL(SUCHEN(Legende_Bearbeitungshinweise;(C3&D3&E3&F3&G3&H3&I3&J3&K3)))*1);"Bearbeitungshinweis";"RS-Titel")="RS-Titel";

WENN(ODER((SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Einsteller;D3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Titel;H3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Dienst;J3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentliches_Sachgebiet;K3))*1));P3="nicht wesentlich");"nicht wesentlicher RS-Titel";"wesentlicher RS-Titel");

WENN(ODER(Q2="nicht wesentlicher Bearbeitungshinweis";

(UND((WENN(SUMME(ISTZAHL(SUCHEN(Legende_Bearbeitungshinweise;(C3&D3&E3&F3&G3&H3&I3&J3&K3)))*1);"Bearbeitungshinweis")="Bearbeitungshinweis");

(WENN(ODER((SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Einsteller;D2))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Titel;H2))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Dienst;J2))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentliches_Sachgebiet;K2))*1));P2="nicht wesentlich");"nicht wesentlicher RS-Titel";"wesentlicher RS-Titel")="nicht wesentlicher RS-Titel"))));

"nicht wesentlicher Bearbeitungshinweis";
"wesentlicher Bearbeitungshinweis"))

&

WENN(
UND(WENN(

ODER((SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Einsteller;D3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Titel;H3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentlicher_Dienst;J3))*1));(SUMME(ISTZAHL(SUCHEN(Legende_Meldewerte_nicht_wesentliches_Sachgebiet;K3))*1)));

"nicht wesentlicher RS-Titel";"wesentlicher RS-Titel")="wesentlicher RS-Titel";

WENN(SUMME(ISTZAHL(SUCHEN(Legende_Bearbeitungshinweise;(C3&D3&E3&F3&G3&H3&I3&J3&K3)))*1);"Bearbeitungshinweis";"RS-Titel")<>"Bearbeitungshinweis");

WENN(ODER(P3<>"";WENN(SUMME(ISTZAHL(SUCHEN(Legende_Bearbeitungshinweise;(C4&D4&E4&F4&G4&H4&I4&J4&K4)))*1);"Bearbeitungshinweis";"RS-Titel")="Bearbeitungshinweis"=WAHR);
"";
" ohne Bearbeitungshinweis!");""))


Kann ich die Formel so in VBA einbinden, dass sie für jede Zeile meiner Tabelle durchlaufen wird. Dabei muss die Möglichkeit bestehen, in der Spalte P per Dropdown "nicht wesentlich" oder "bearbeitet" zu wählen und damit das Ergebnis in Spalte Q zu beeinflussen. Das habe ich aktuell über eine Gültigkeitsprüfung und wenn-dann-Schleife dargestellt.

Ich hoffe, ich habe das hier klar genug ausdrücken können. Falls Ihr eine Idee habt, können wir darüber vor der Umsetzung gerne schreiben. Es wäre schade, wenn Ihr Euch Arbeit macht, und wir aneinander vorbeireden.

  

Betrifft: AW: Formel in VBA darstellen von: fcs
Geschrieben am: 02.10.2014 17:54:53

Hallo Frank,


eine kleine Beispieldatei wäre Hilfreich, wen dir geholfen werden soll.

Ansonsten solltest du während der Ausführung der Copy-Paste-Aktionen den Berechnungsmodus auf manuell setzen und die Bildschirmaktualisierung deaktivieren.

Evtl. gibt es ja auch noch Optimierungspotential in den Formeln selber.

Gruß
Franz


  

Betrifft: AW: Formel in VBA darstellen von: Frank Berends
Geschrieben am: 02.10.2014 18:08:21

Hallo Franz,

nach den Feiertagen stelle ich ein Muster hier ein. Bis dahin schon mal besten Dank.

Gruß
Frank


  

Betrifft: AW: Formel in VBA darstellen von: Frank Berends
Geschrieben am: 06.10.2014 12:23:23

Hallo Franz,

wie geschrieben stelle ich heute eine etwas abgespeckte Version der Datei ein. Die Grundidee ist hier unverändert, ich hab nur ein paar "interne Vermerke" rausnehmen müssen.

https://www.herber.de/bbs/user/92980.xlsx

Das mit der manuellen Berechnung habe ich auch schon überlegt. Aber die Gefahr sehe ich, wenn ich die manuellen Eingaben in der vorletzen Spalte nutze und dann eben nicht auf "berechnen" geklickt wird.

Gruß
Frank


  

Betrifft: AW: Formel in VBA darstellen von: fcs
Geschrieben am: 06.10.2014 16:16:39

Hallo Frank,

ich tu mich extrem schwer, die Formeln in Spalte Q (Status) der Tabelle 2 nachzuvollziehen.
Außerdem scheinen die Formeln systematisch unterschiedlich zu sein; bei einigen Formeln gibt es Bezüge zu Zellen oberhalb der Zeile mit der Formel, bei einigen nicht. Bei anderen zu Zellen in den Zeilen unter- und oberhalb der Formelzeile.

Ich kann diese Systematik nicht nachvollziehen.
Hier wäre es hilfreich, wenn du die Prüfungen und Ergebnisse der Formel in einer Zelle Spalte Q nochmals schrittweise beschreiben würdest so dass man danach dann eine VBA-Funktion bauen kann.

Gruß
Franz


  

Betrifft: AW: Formel in VBA darstellen von: Frank Berends
Geschrieben am: 06.10.2014 17:05:35

Hallo Franz,

offensichtlich hat meine erste Antwort nicht funktioniert. Bitte schau Dir dies hier mal an:

https://www.herber.de/bbs/user/92983.xlsx

Gruß
Frank


  

Betrifft: AW: Formel in VBA darstellen von: fcs
Geschrieben am: 07.10.2014 09:39:52

Hallo Frank,

mit deiner Exceldatei hab nach dem Runterladen beim Öffnen Problem.
Excel findet nicht lesbare Inhalte und die Reparatur endet dann damit, dass eine eingebettete Grafik nicht dargestellt bzw. gelöscht wird.

Gruß
Franz


  

Betrifft: AW: Formel in VBA darstellen von: fcs
Geschrieben am: 07.10.2014 13:16:09

Hallo Frank,

ich hab jetzt mal versucht, die Formeln in Spalte Q in eine entsprechende benutzerdefinierte VBA-Funktion umzusetzen.

Formelbeispeil für Zelle Q2:

=fncStatus(Q1;[@Einsteller];[@manuell];Tabelle2[@[Datum]:[Sachgebiet]];C1:K1;
C3:K3;Legende_Bearbeitungshinweise;Legende_Meldewerte_nicht_wesentlicher_Einsteller;
Legende_Meldewerte_nicht_wesentliches_Sachgebiet;
Legende_Meldewerte_nicht_wesentlicher_Dienst;
Legende_Meldewerte_nicht_wesentlicher_Titel)
Ich kann jetzt nichts sagen zur Rechengeschwindigkeit bei Verwendung von Matrixformeln und VBA-Funktion wenn jetzt viele Datenzeilen vorhanden sind. Masse braucht nun einmal ihre Zeit insbesondere, da fast jede Daten-Änderung zu einer kompletten Neuberechnung in Spalte Q führt.

Am Ende ist es möglicherweise sinnvoll, die Formeln nur zur Aktualisierung einzufügen und dann nach Neuberechnung durch die Werte zu erstzen.


Gruß
Franz
'Code in einem allgemeinen Modul der Datei
Function fncStatus(ZelleOberhalb As Range, D_Einsteller As Range, P_manuell As Range, _
  rngC_K As Range, rngC_K_oberhalb, rngC_K_unterhalb, _
  Leg_Bearbeitungshinweise As Range, nwEinsteller As Range, _
  nwSachgebiet As Range, nwDienst As Range, nwTitel As Range)
  Dim Zelle As Range
  Dim strC_K                    'Text in den Zellen aus Spalten C bis K
  Dim strC_K_naechste           'Text in den Zellen aus Spalten C bis K der folgenden Zeile
  Dim bolRS_Titel As Boolean    'Merker, ob Titel oder Bearbeitungshinweis
  Dim bolNW_RS_Titel As Boolean 'Merker, ob nicht wichtiger Titel in Zeile
  Dim bolNW_RS_Titel_oberhalb As Boolean 'Merker, ob nicht wichtiger Titel in Zeile oberhalb
  
  'Werte in Spalten C bis K in einem String zusammenfügen
  For Each Zelle In rngC_K.Cells
    'Werte in Zeile
    strC_K = strC_K & Zelle.Text
  Next
  For Each Zelle In rngC_K_unterhalb.Cells
    'Werte in nächster Zeile
    strC_K_naechste = strC_K_naechste & Zelle.Text
  Next
  
  If D_Einsteller = "Einsteller" Or strC_K = "" Then
    fncStatus = " "
    GoTo Beenden
  End If
  
  'Prüfen, ob Legendeneinträge aus Bearbeitungshinweisen in Zeile vorhanden
  bolRS_Titel = fncSuchen(rngSuchWerte:=Leg_Bearbeitungshinweise, strWert:=strC_K)
  
  'Prüfen, ob nicht wichtiger RS-Titel in Zeile
  If fncSuchen(rngSuchWerte:=nwEinsteller, strWert:=rngC_K.Cells(1, 2)) _
    Or fncSuchen(rngSuchWerte:=nwTitel, strWert:=rngC_K.Cells(1, 6)) _
    Or fncSuchen(rngSuchWerte:=nwDienst, strWert:=rngC_K.Cells(1, 8)) _
    Or fncSuchen(rngSuchWerte:=nwSachgebiet, strWert:=rngC_K.Cells(1, 9)) Then
      bolNW_RS_Titel = True
  Else
      bolNW_RS_Titel = False
  End If
  
  'Prüfen, ob nicht wichtiger RS-Titel in Zeile oberhalb
  If fncSuchen(rngSuchWerte:=nwEinsteller, strWert:=rngC_K_oberhalb.Cells(1, 2)) _
    Or fncSuchen(rngSuchWerte:=nwTitel, strWert:=rngC_K_oberhalb.Cells(1, 6)) _
    Or fncSuchen(rngSuchWerte:=nwDienst, strWert:=rngC_K_oberhalb.Cells(1, 8)) _
    Or fncSuchen(rngSuchWerte:=nwSachgebiet, strWert:=rngC_K_oberhalb.Cells(1, 9)) Then
      bolNW_RS_Titel_oberhalb = True
  Else
    bolNW_RS_Titel_oberhalb = False
  End If
  
  If bolRS_Titel = False Then 'kein Bearbeitungshinweis in Zeile
    If bolNW_RS_Titel = True Or P_manuell.Value = "nicht wesentlich" Then
      fncStatus = "nicht wesentlicher RS-Titel"
    Else
      fncStatus = "wesentlicher RS-Titel"
    End If
  Else 'Bearbeitungshinweis in Zeile
    If ZelleOberhalb.Value = "nicht wesentlicher Bearbeitungshinweis" Or _
        (bolRS_Titel = True And bolNW_RS_Titel_oberhalb = True) Or _
        P_manuell.Offset(-1, 0).Value = "nicht wesentlich" Then
      fncStatus = "nicht wesentlicher Bearbeitungshinweis"
    Else
      fncStatus = "wesentlicher Bearbeitungshinweis"
    End If
  End If
  
  'Textergänzung bezüglich Bearbeitungshinweis
  If bolNW_RS_Titel = False And bolRS_Titel = False Then
    If P_manuell.Value <> "" Or _
      fncSuchen(rngSuchWerte:=Leg_Bearbeitungshinweise, strWert:=strC_K_naechste) _
      = True Then
    
    Else
      fncStatus = fncStatus & " ohne Bearbeitungshinweis!"
    End If
  End If
Beenden:
End Function

Function fncSuchen(ByVal rngSuchWerte As Range, ByVal strWert) As Boolean
  'Prüft ob einer der Werte im Zellbereich zu durchsuchenden Text enthalten ist
  Dim Zelle As Range
  Dim strText As String
  strText = LCase(strWert)
  For Each Zelle In rngSuchWerte.Cells
    If InStr(1, strText, LCase(Zelle.Text)) > 0 And Zelle.Text <> "" Then
      fncSuchen = True
      Exit Function
    End If
  Next
End Function



  

Betrifft: AW: Formel in VBA darstellen von: Frank Berends
Geschrieben am: 07.10.2014 15:50:45

Hallo Franz,

besten Dank für die Antwort. Ich werde es ausprobieren und mich melden.

Gruß
Frank


 

Beiträge aus den Excel-Beispielen zum Thema "Formel in VBA darstellen"