Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
356to360
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
356to360
356to360
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro um Funktion erweitern

Makro um Funktion erweitern
04.01.2004 18:21:19
Dieter
Hallo Forum,ich habe eine Exceldatei mit zwei Arbeitsblätter.In Tabelle1 ist eine Schaltfläche
mit der ich unten stehendes Makro starte es geht alles besten nun meine Frage,kann dieses Makro
so erweitert werden das in der Tabelle2 eine Tabelle erstellt wird die sollte beinhalten wie oft
ein Mitspieler gewonnen hat und den bisher gewonnenen Betrag. Das ganze soll das ganze Jahr über
gesammelt werden.Bis zur jetzigen Zeit führe ich diese Tabelle noch manuell.Ist diese Vorstellung
zu realisieren ?.
MfG Dieter




Private Sub CommandButton1_Click()
Dim Zusatzzahl
Titel = "Zusatzzahl"
Mldg = "Zusatzzahl eingeben"
Zusatzzahl = InputBox(Mldg, Titel)
With Sheets(1).Range(Cells(101, 2), Cells(126, 3))
Set C = .Find(Zusatzzahl, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Cells(100, 2).End(xlUp).Row + 1
Cells(r, 5) = "xxx" '<<<<<
Cells(r, 3) = "nein"
Cells(r, 2) = Zusatzzahl
MsgBox "Zusatzzahl nicht vorhanden"
Exit Sub
End If
End With
r = Cells(100, 2).End(xlUp).Row + 1
If r < 4 Then r = 5
If C(1, 1).Column = 2 Then f = 0 Else f = -1
Cells(r, 5) = C(1, f)
Cells(r, 2) = C(1, 1)
Cells(r, 3) = "ja"
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro um Funktion erweitern
05.01.2004 21:45:01
Beni
Hallo Dieter,
Gruss Beni


Private Sub CommandButton1_Click()
Dim Zusatzzahl
Titel = "Zusatzzahl"
Mldg = "Zusatzzahl eingeben"
Zusatzzahl = InputBox(Mldg, Titel)
With Sheets(1).Range(Cells(101, 2), Cells(126, 3))
Set C = .Find(Zusatzzahl, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Cells(100, 2).End(xlUp).Row + 1
Cells(r, 5) = "xxx" '<<<<<
Cells(r, 3) = "nein"
Cells(r, 2) = Zusatzzahl
MsgBox "Zusatzzahl nicht vorhanden"
Exit Sub
End If
End With
r = Cells(100, 2).End(xlUp).Row + 1
If r < 4 Then r = 5
If C(1, 1).Column = 2 Then f = 0 Else f = -1
Cells(r, 5) = C(1, f)
Cells(r, 2) = C(1, 1)
Cells(r, 3) = "ja"
With Sheets(2).Columns(1)
Spieler = Cells(r, 5)
Set S = .Find(Spieler, LookIn:=xlValues, LookAt:=xlWhole)
If S Is Nothing Then
i = .Cells(65536, 1).End(xlUp).Row + 1
.Cells(i, 1) = Cells(r, 5)
.Cells(i, 2) = 1
Else
S(1, 2) = S(1, 2) + 1
End If
End With
End Sub

Anzeige
AW: Makro um Funktion erweitern
06.01.2004 09:54:22
Dieter
Hallo Beni,habe garnicht mehr mit einer Antwort gerechnet.Vielen Dank für die Mühe,es funz doch eine Sache habe ich noch in der Tabelle1 steht ab Spalte F5 der Betrag der Ausgespielt wird und der Spieler gewonnen hat der wird aber nicht mit in die Tabelle2 mit übernommen geht das auch noch mit einzubauen?
MfG Dieter
AW: Makro um Funktion erweitern
06.01.2004 11:45:27
Beni
Hallo Dieter,
was meinst Du mit "ab Spalte F5 der Betrag der Ausgespielt wird"
in dieser Version wird der Wert aus F5 hinzu gezählt.
Gruss Beni


Private Sub CommandButton1_Click()
Dim Zusatzzahl
Titel = "Zusatzzahl"
Mldg = "Zusatzzahl eingeben"
Zusatzzahl = InputBox(Mldg, Titel)
With Sheets(1).Range(Cells(101, 2), Cells(126, 3))
Set C = .Find(Zusatzzahl, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
r = Cells(100, 2).End(xlUp).Row + 1
Cells(r, 5) = "xxx" '<<<<<
Cells(r, 3) = "nein"
Cells(r, 2) = Zusatzzahl
MsgBox "Zusatzzahl nicht vorhanden"
Exit Sub
End If
End With
r = Cells(100, 2).End(xlUp).Row + 1
If r < 4 Then r = 5
If C(1, 1).Column = 2 Then f = 0 Else f = -1
Cells(r, 5) = C(1, f)
Cells(r, 2) = C(1, 1)
Cells(r, 3) = "ja"
With Sheets(2).Columns(1)
Spieler = Cells(r, 5)
Set S = .Find(Spieler, LookIn:=xlValues, LookAt:=xlWhole)
If S Is Nothing Then
i = .Cells(65536, 1).End(xlUp).Row + 1
.Cells(i, 1) = Cells(r, 5)
.Cells(i, 2) = 1
Else
S(1, 2) = S(1, 2) + 1
S(1, 3) = S(1, 3) + Cells(5, 6) '<<<<<<
End If
End With
End Sub

Anzeige
Danke Beni !!!!
06.01.2004 12:07:26
Dieter
Danke Beni es Klappt wunderbar
MfG Dieter
AW: Makro um Funktion erweitern
07.01.2004 09:38:16
Dieter
Hi Beni, kannst du dir die Datei mal anschauen ?
MfG Dieter
Die Datei hochgeladen
06.01.2004 11:58:50
Dieter
Hallo Beni zur Erklärung die Datei
MfG Dieter
AW: Die Datei hochgeladen
06.01.2004 23:07:17
Dieter
Hallo Beni, habe heute Mittag nur kurz getestet und es machte den Anschein das alles Ok wäre nun habe ich aber festgestellt das es nicht so ist.
Habe mal die Datei hochgeladen wenn es dir möglich ist einmal reinzuschauen.
MfG Dieter
AW: Die Datei hochgeladen
06.01.2004 23:08:33
Dieter
Hallo Beni, habe heute Mittag nur kurz getestet und es machte den Anschein das alles Ok wäre nun habe ich aber festgestellt das es nicht so ist.
Habe mal die Datei hochgeladen wenn es dir möglich ist einmal reinzuschauen.
MfG Dieter https://www.herber.de/bbs/user/2794.xls
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige