Tabellenblattstruktur mit VBA erstellen

[Steffl]

Hallo Frank,

das Einzige was ich verstanden habe, ist das Du in Zelle E10 eine Summenformel stehen hast. Den Rest habe ich nicht verstanden. Könntest Du die Datei hier hochladen bzw einen Tabellenausschnitt hier darstellen?

[WergibtmirRat]

Hallo Stefan, genau das habe ich befürchtet, aus diesem Grund hier eine Tabelle, aber nur Daten keine Code.

  Formeln in Makro reinlegen oder woanders.xlsx (Größe: 12,47 KB / Downloads: 6)
Im übrigen Danke für die aufopfernde Zeit deinerseits (eurer allen)

mfg

[Steffl]

Hallo Frank,

ich hatte jetzt viele vergebliche Versuche um deine Array-Formel angepaßt zu kriegen bis ich bemerkt habe. Es geht auch ohne Array. Ob da unbedingt eine Array-Formel benötigt wird, weiß ich nicht. Zumindest komme ich in deiner Beispieldatei auf dasselbe Ergebnis wie Du. Ich habe bei den Formel die Abfrage nach den 2 Neunen und den Hausnummern entfernt. Aber teste mal selber.

Code:

Sub prcFranksFormelnEintragen()
   Dim lngC As Long
  
   With Worksheets("Tabelle1")
      For lngC = 2 To .Cells(.Rows.Count, 4).End(xlUp).Row
         Select Case .Cells(lngC, 4).Value
            Case "2 auf die Vollen"
               .Cells(lngC, 32).FormulaR1C1 = "=IF(RC[-25]=""AA"",4,IF(RC[-25]=""s"",3,IF(RC[-25]=""x"",0,IF(RC[-25]=""k"",8,RC[-25]))))+IF(RC[-24]=""AA"",4,IF(RC[-24]=""s"",3,IF(RC[-24]=""x"",0,IF(RC[-24]=""k"",8,RC[-24]))))"
            Case "gr.H.Nr.", "kl.H.Nr."
               .Cells(lngC, 32).FormulaR1C1 = "=IF(RC[-25]=""AA"",4*100,IF(RC[-25]=""s"",3*100,IF(RC[-25]=""x"",0*100,IF(RC[-25]=""k"",8*100,RC[-25]*100))))+IF(RC[-24]=""AA"",4*10,IF(RC[-24]=""s"",3*10,IF(RC[-24]=""x"",0*10,IF(RC[-24]=""k"",8*10,RC[-24]*10))))+IF(RC[-23]=""AA"",4,IF(RC[-23]=""s"",3,IF(RC[-23]=""x"",0,IF(RC[-23]=""k"",8,RC[-23]))))"
            Case Else
               .Cells(lngC, 32).Value = ""
         End Select
      Next lngC
   End With

End Sub

PS: Die Formel werden in der Spalte AF eingetragen. Ist kein passender Auswahl in der Spalte D drin, ist die Zelle leer.

[WergibtmirRat]

PHP-Code:

Sub prcFranksFormelnEintragen()   ' Spieleberechnung
' Suchspalte ist C
' Suchspalte ist 3
' von AE auf E  ; F  ; G  ; H  ; I ;  J ;  K ;  L ;  M ;  N ;  O ;  P ;  Q ;  R ;  S ;  T ;  U  ; V ; W ; X
' von 31 auf 26 ; 25 ; 24 ; 23 ; 22 ; 21 ; 20 ; 19 ; 18 ; 17 ; 16 ; 15 ; 14 ; 13 ; 12 ; 11 ; 10 ; 9 ; 8 ; 7
' von AE = 31 aus nach links gezählt
' ########### Spiele ############
' #    2 auf die Vollen         #
' #    gr.H.Nr.                 #
' #    kl.H.Nr.                 #
' # Plus Plus Minus Mal Geteilt #
' ########### Spiele ############
Dim lngC As Long
   With Worksheets("26.08.2014")
      For lngC = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row
         Select Case .Cells(lngC, 3).Value
            Case "2 auf die Vollen"
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(IF(RC[-26]=""a"",4,IF(RC[-26]=""s"",3,IF(RC[-26]=""x"",0,IF(RC[-26]=""k"",8,RC[-26]))))+IF(RC[-25]=""a"",4,IF(RC[-25]=""s"",3,IF(RC[-25]=""x"",0,IF(RC[-25]=""k"",8,RC[-25])))),"""")"
            Case "gr.H.Nr."
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(((SUMPRODUCT(IF(ISNUMBER(RC[-26]),RC[-26],LOOKUP(RC[-26],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*100))+SUMPRODUCT(IF(ISNUMBER(RC[-25]),RC[-25],LOOKUP(RC[-25],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*10))+SUMPRODUCT(IF(ISNUMBER(RC[-24]),RC[-24],LOOKUP(RC[-24],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*1),"""")"
            Case "kl.H.Nr."
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(((SUMPRODUCT(IF(ISNUMBER(RC[-26]),RC[-26],LOOKUP(RC[-26],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*100))+SUMPRODUCT(IF(ISNUMBER(RC[-25]),RC[-25],LOOKUP(RC[-25],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*10))+SUMPRODUCT(IF(ISNUMBER(RC[-24]),RC[-24],LOOKUP(RC[-24],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*1),"""")"
            Case "Plus Plus Minus Mal Geteilt"
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(SUM((((IF(RC[-26]=""a"",4,IF(RC[-26]=""s"",3,IF(RC[-26]=""x"",0,IF(RC[-26]=""k"",8,RC[-26]))))+IF(RC[-25]=""a"",4,IF(RC[-25]=""s"",3,IF(RC[-25]=""x"",0,IF(RC[-25]=""k"",8,RC[-25])))))-IF(RC[-24]=""a"",4,IF(RC[-24]=""s"",3,IF(RC[-24]=""x"",0,IF(RC[-24]=""k"",8,RC[-24])))))*IF(RC[-23]=""a"",4,IF(RC[-23]=""s"",3,IF(RC[-23]=""x"",0,IF(RC[-23]=""k"",8,RC[-23])))))/IF(RC[-22]=""a"",4,IF(RC[-22]=""s"",3,IF(RC[-22]=""x"",0,IF(RC[-22]=""k"",8,RC[-22]))))),"""")"
            Case Else
               .Cells(lngC, 31).Value = ""
         End Select
      Next lngC
   End With
End Sub 


Hallo Stefan & @all
Wie kann ich verhindern das der Makrocode immer über die ganze Liste berechnen will.
Eingetragenes ist ja schon berechnet, es soll aber nur letzte aktuelle Zeile berechnet werden.
Mit

PHP-Code:

Application.ScreenUpdating = False
Application.EnableEvents = False 


kenne ich mich noch nicht aus, geschweige wo muss das eingesetzt werden?
Direkt im UserForm_Initialize
oder im Makro?

Problem Nr. 2:

PHP-Code:

Dim lngC As Long
   With Worksheets("26.08.2014") 


Wie auf das aktuelle Tabellenblatt fokusieren?

Ich bitte euch um Hilfe, hab wieder mal nen Wald vor Augen...


mfg

[BoskoBiati]

Hallo,

wie wäre es mit dieser einfachen Formel:

=WENN(LINKS(D2;3)="2 a";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)+WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2);WENN(LINKS(D2;3)="gr.";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;0});I2);WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;9});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;9});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;9});I2)))

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E	F	G	H	I	J	K	L	AF
2	24.08.2014	14:16	Egon	2 auf die Vollen	01	01	k	4					12
3	24.08.2014	14:17	Bertha	2 auf die Vollen	02	01	3	7					10
4	24.08.2014	14:19	Egon	gr.H.Nr.	01	02	7	5	3				753
5	24.08.2014	14:20	Bertha	gr.H.Nr.	02	02	4	2	3				423
6	24.08.2014	14:22	Egon	kl.H.Nr.	01	03	aa	s	4				434
7	24.08.2014	14:23	Bertha	kl.H.Nr.	02	03	k	1	x				819

Zelle

Formel

AF2

=WENN(D2="";"";WENN(LINKS(D2;3)="2 a";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)+WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2);WENN(LINKS(D2;3)="gr.";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;0});I2);WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;9});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;9});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;9});I2))))

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

[schauan]

Hallo Frank,

in Excel - VBA ist das aktive Blatt clevererweise ActiveSheet

Wenn Du Deinen code in einer Schleife über alle Zeilen legst, dann wird auch alles gemacht.
For lngC = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row

Wenn Du nur die letzte bearbeiten willst, dann nimm auch nur die letzte.
.Cells(.Rows.Count, 3).End(xlUp).Row


Zusammengefasst also

With ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row

und unten das zur Schleife gehörende Next entfernen.

[WergibtmirRat]

Hallo @all
Danke an Edgar & André,
für eure Beiträge/Lösungsansätze
Habe die Formel noch nicht eingepflegt bzw. auf Active geändert.
sind dann somit die Anweisungen hinfällig mit einzubauen?

Application.ScreenUpdating und .EnableEvent

mfg

[schauan]

Hallo Frank,
Du tust nur die Schleife weg, es wäre schon clever, die Formeleinträge in dein Excelblatt einzutragen.

[WergibtmirRat]

Hallo André
bekomme Fehlermeldung:
Fehler beim Kpmpilieren
Unzulässiger oder nicht ausreichend definierter Verweis

With ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row

da nochmal der Code

PHP-Code:

Private Sub prcFranksFormelnEintragen_Click() 'Spieleberechnung
'Dim lngC As Long                                                         richtig wenn deaktiviert ?
With ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row
'   With ActiveSheet 'Worksheets("29.08.2014")
    Application.ScreenUpdating = False
'      For lngC = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row
         Select Case .Cells(lngC, 3).Value
            Case "2 auf die Vollen"
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(IF(RC[-26]=""a"",4,IF(RC[-26]=""s"",3,IF(RC[-26]=""x"",0,IF(RC[-26]=""k"",8,RC[-26]))))+IF(RC[-25]=""a"",4,IF(RC[-25]=""s"",3,IF(RC[-25]=""x"",0,IF(RC[-25]=""k"",8,RC[-25])))),"""")"
            Case "gr.H.nr."
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(((SUMPRODUCT(IF(ISNUMBER(RC[-26]),RC[-26],LOOKUP(RC[-26],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*100))+SUMPRODUCT(IF(ISNUMBER(RC[-25]),RC[-25],LOOKUP(RC[-25],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*10))+SUMPRODUCT(IF(ISNUMBER(RC[-24]),RC[-24],LOOKUP(RC[-24],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*1),"""")"
            Case "kl.H.nr."
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(((SUMPRODUCT(IF(ISNUMBER(RC[-26]),RC[-26],LOOKUP(RC[-26],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*100))+SUMPRODUCT(IF(ISNUMBER(RC[-25]),RC[-25],LOOKUP(RC[-25],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*10))+SUMPRODUCT(IF(ISNUMBER(RC[-24]),RC[-24],LOOKUP(RC[-24],{""a"";""k"";""o"";""s"";""x""},{4;8;9;3;0}))*1),"""")"
            Case "Plus Plus Minus Mal Geteilt"
               .Cells(lngC, 31).FormulaR1C1 = "=IFERROR(SUM((((IF(RC[-26]=""a"",4,IF(RC[-26]=""s"",3,IF(RC[-26]=""x"",0,IF(RC[-26]=""k"",8,RC[-26]))))+IF(RC[-25]=""a"",4,IF(RC[-25]=""s"",3,IF(RC[-25]=""x"",0,IF(RC[-25]=""k"",8,RC[-25])))))-IF(RC[-24]=""a"",4,IF(RC[-24]=""s"",3,IF(RC[-24]=""x"",0,IF(RC[-24]=""k"",8,RC[-24])))))*IF(RC[-23]=""a"",4,IF(RC[-23]=""s"",3,IF(RC[-23]=""x"",0,IF(RC[-23]=""k"",8,RC[-23])))))/IF(RC[-22]=""a"",4,IF(RC[-22]=""s"",3,IF(RC[-22]=""x"",0,IF(RC[-22]=""k"",8,RC[-22]))))),"""")"
            Case Else
               .Cells(lngC, 31).Value = ""
         End Select
'      Next lngC                                                            richtig wenn deaktiviert ?
    Application.ScreenUpdating = True
   End With
End Sub 


Hallo Edgar
wie bekomme ich nun die Formel in meinen obrigen (geposteten) Code hinein?

Code:

=WENN(D2="";"";WENN(LINKS(D2;3)="2 a";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)+WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2);WENN(LINKS(D2;3)="gr.";WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;0});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;0});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;0});I2);WENN(ISTTEXT(G2);VERWEIS(G2;{"AA";"k";"s";"x"};{4;8;3;9});G2)&WENN(ISTTEXT(H2);VERWEIS(H2;{"AA";"k";"s";"x"};{4;8;3;9});H2)&WENN(ISTTEXT(I2);VERWEIS(I2;{"AA";"k";"s";"x"};{4;8;3;9});I2))))

allen ein trockenes Wochenende
mfg

[schauan]

Hallo Frank,
Sorry, nicht nur das .row war zu viel. Schreibe nur with activesheet und dann Select Case .cells(rows.count,3)...