MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 30.12.2016, 02:45   #1
PanteraNera
Neuer Benutzer
Neuer Benutzer
Standard VBA - Zelleninhalt kopieren, wenn heutiges Datum

Hallo zusammen,

für meine Fussballdatenbank fehlen mir noch zwei Funktionen und ich hoffe, das ihr mir bei meinem Problem wieder behilflich sein könnt.
Ich habe mehrere Tabellenblätter ( bis zu 60 Ligen ) und möchte nun gerne, dass mir die aktuellen Spiele ( wenn heutiges Datum ) herausgefiltert und diese in einer neuen Seite anzeigt werden, damit man sofort einen Überblick auf die Spiele des Tages hat.

Ich möchte gerne, dass wenn man die Exceldatei öffnet, diese alle 60 Ligen durchgeht und die Spiele dann alle anzeigt.

Ich habe im Internet schon nach einer Lösung gesucht, aber leider nichts finden können.

Für ein besseres Verständnis lade ich wieder eine Beispieldatei hoch.

Vielen Dank schon mal im Voraus.

Gruß
Alberto
Angehängte Dateien
Dateityp: xls mof - zelleninhalt kopieren, wenn heutiges Datum.xls (17,5 KB, 6x aufgerufen)
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.12.2016, 09:47   #2
Hajo_Zi
MOF Guru
MOF Guru
Standard

Hallo Alberto,

arbeite doch mit Autofilter, ist nicht so aufwendig.
Falls Du Ergebnisse eintragen willst bist Du gleich in der richtigen Tabelle.

GrußformelHomepage

__________________

Signatur in jedem Beitrag
m Forum kann der Beitrag als erledigt markiert werden. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.
Bitte Version angeben. Bei keiner Angabe gehe ich von meinen Angaben aus.
Betriebssystem: Windows 10 - 64 Bit, Office 2016 - 32 Bit.
Hajo_Zi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.12.2016, 11:06   #3
hary
MOF Guru
MOF Guru
Standard

Moin
Mit Filter beim oeffnen.Siehe Anhang.
gruss hary
Angehängte Dateien
Dateityp: xls wenn heutiges Datum.xls (68,0 KB, 6x aufgerufen)
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.12.2016, 19:09   #4
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo zusammen,

vielen Dank für Eure Antworten.

@hary:
Bei deinem Code bekomme ich bei "xlFilterToday" folgende Fehlermeldung:

Fehler beim Kompilieren:
Variable nicht definiert

Woran kann das liegen?

Gruß
Alberto
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.12.2016, 02:36   #5
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo hary,

ich habe folgende Zeile aus deinem Code
Code:

.AutoFilter Field:=1, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
in diese umgeändert

Code:

.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Date), Operator:=xlAnd
und es funktioniert
Vielen lieben Dank für deinen Code.

Ich hätte da aber noch eine Frage was die Optik betrifft und wollte fragen, ob dies ebenfalls per VBA möglich wäre.
Fürs bessere Verständnis füge ich die Datei nochmal hoch.

Vielen Dank schon mal für die Mühe.

Gruß
Alberto
Angehängte Dateien
Dateityp: xls wenn heutiges Datum.xls (82,0 KB, 2x aufgerufen)
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.12.2016, 08:54   #6
hary
MOF Guru
MOF Guru
Standard

Moin
Siehe Anhang. Evtl. nicht schoen der Code aber funzt.
gruss und ab ins neue Jahr
hary
Angehängte Dateien
Dateityp: xls mit Farben.xls (57,5 KB, 3x aufgerufen)
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.12.2016, 12:53   #7
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Buongiorno hary,

danke für deine Antwort.

Der Code mit den Farben funktioniert soweit, aber wenn es mehrere Spiele an einem Tag sind, dann leider nicht mehr.
Der wechselt dann nicht mehr zwischen weiss und grau.
Ich musste deinen Code auch wieder etwas sumschreiben, da ich noch Excel 2003 besitze, aber habe nur die Zeile mit dem Farbcode geändert.
Sollte nicht daran liegen, oder?

Und ich hätte da noch eine kleine Frage:
Wie müsste ich den Code umändern, damit er mir von B-G die Zeile farblich ändert?
Und wäre es möglich, die Spalten E-G ( wo das Land steht ) automatisch mit
1 X und 2 zu füllen? Also in E die 1 in F das X und in G dann die 2?

Habe dir wieder einen Screenshot mit beigefügt, wie ich es mir vorstelle.

Danke dir schon mal für deine Mühe und wünsche dir einen guten Rutsch ins neue Jahr.

Gruß
Alberto
Angehängte Dateien
Dateityp: xls mit Farben.xls (93,5 KB, 5x aufgerufen)
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.12.2016, 15:12   #8
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Buongiorno hary,

ich habe es lösen können mit folgendem Code:

Code:

Sub Tagesaktuell()
Dim wks As Worksheet, wksZ As Worksheet
Dim letzte As Long, letzteA As Long, zeile As Long, i As Long, zaehler As Byte
Application.ScreenUpdating = False
Set wksZ = Worksheets("Spiele des Tages")
wksZ.Cells.Clear
For Each wks In Worksheets
 If wks.Name <> wksZ.Name Then
  If Application.CountIf(wks.Columns(2), CLng(Date)) Then
    letzte = wks.Cells(Rows.Count, 2).End(xlUp).Row
      With wks.Range("B3:D" & letzte)
        letzteA = wksZ.Cells(Rows.Count, 2).End(xlUp).Row
          If zaehler Then letzteA = letzteA + 1
            .AutoFilter Field:=1, Criteria1:=">=" & CDbl(Date), Operator:=xlAnd
              wksZ.Cells(letzteA + 1, 2) = wks.Name
              wksZ.Cells(letzteA + 1, 5) = 1
              wksZ.Cells(letzteA + 1, 6) = "X"
              wksZ.Cells(letzteA + 1, 7) = 2
              wksZ.Cells(letzteA + 1, 2).Resize(1, 3).Font.Underline = xlUnderlineStyleSingle
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Font.Bold = True
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Font.Size = 9
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Interior.ColorIndex = 15
            zeile = wks.AutoFilter.Range.Offset(1, 0).SpecialCells(xlVisible).Rows.Count - 1
            wks.AutoFilter.Range.Offset(1, 0).SpecialCells(xlVisible).Copy wksZ.Cells(letzteA + 2, 2)
              If zeile > 1 Then
               For i = 2 To zeile Step 2
                wksZ.Cells(letzteA + zaehler + zeile, 2).Resize(1, 3).Font.Size = 8
               Next
              End If
            .AutoFilter
      End With
      zaehler = 1
  End If
 End If
Next
Columns("E:G").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2").Select
End Sub

Zitat:

Wie müsste ich den Code umändern, damit er mir von B-G die Zeile farblich ändert?
Und wäre es möglich, die Spalten E-G ( wo das Land steht ) automatisch mit
1 X und 2 zu füllen? Also in E die 1 in F das X und in G dann die 2?

Dieses hier habe ich damit lösen können.

Das mit dem weiss und grau habe ich nicht hinbekommen und deswegen die Codezeile gelöscht, so dass es nun alles in weiss ist.

So gefällt mir auch sehr gut.
Solltest du trotzdem noch Lust und Zeit haben es nochmal zu versuchen wegen dem weiss grauen wäre ich dir sehr dankbar.

Guten Rutsch an allen.

Gruß
Alberto
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2017, 06:41   #9
hary
MOF Guru
MOF Guru
Standard

Moin Alberto

Zitat:

da ich noch Excel 2003 besitze,

Das ist der Grund. Habe 2007.
Schaue aber noch mal drueber.
gruss hary
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2017, 10:27   #10
hary
MOF Guru
MOF Guru
Standard

Moin
Hab es noch dazwischen schieben koennen.
siehe Anhang.
gruss hary
Angehängte Dateien
Dateityp: xls mit Farben(3).xls (55,0 KB, 4x aufgerufen)
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.01.2017, 21:31   #11
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ciao hary,

bin leider erst jetzt dazu gekommen mit das anzuschauen.
Vielen lieben Dank, genau so soll es aussehen

Gruß
Alberto
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.04.2017, 05:45   #12
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ciao hary, Ciao zusammen,

ich bin leider erst jetzt dazu gekommen, den Code in meiner richtigen Exceldatei einzufügen und da ist mir aufgefallen, dass er nicht nur die Spiele kopiert, die Tagesaktuell sind, sondern auch die Spiele, die in der Zukunft liegen.

Dies hier ist der Code:
Code:

Option Explicit
Sub Tagesaktuell()
Dim wks As Worksheet, wksZ As Worksheet
Dim letzte As Long, letzteA As Long, zeile As Long, i As Long, zaehler As Byte
Application.ScreenUpdating = False
Set wksZ = Worksheets("Spiele des Tages")
 wksZ.Cells.Clear
For Each wks In Worksheets
 If wks.Name <> wksZ.Name Then
  If Application.CountIf(wks.Columns(2), CLng(Date)) Then
    letzte = wks.Cells(Rows.Count, 2).End(xlUp).Row
      With wks.Range("B3:D" & letzte)
        letzteA = wksZ.Cells(Rows.Count, 2).End(xlUp).Row
          If zaehler Then letzteA = letzteA + 1
            .AutoFilter Field:=1, Criteria1:=">=" & CDbl(Date), Operator:=xlAnd
              wksZ.Cells(letzteA + 1, 2) = wks.Name
              wksZ.Cells(letzteA + 1, 5) = 1
              wksZ.Cells(letzteA + 1, 6) = "X"
              wksZ.Cells(letzteA + 1, 7) = 2
              wksZ.Cells(letzteA + 1, 2).Resize(1, 3).Font.Underline = xlUnderlineStyleSingle
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Font.Bold = True
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Font.Size = 9
              wksZ.Cells(letzteA + 1, 2).Resize(1, 6).Interior.ColorIndex = 15
            wks.AutoFilter.Range.Offset(1, 0).SpecialCells(xlVisible).Copy wksZ.Cells(letzteA + 2, 2)
            zeile = wksZ.Cells(letzteA + 1, 2).End(xlDown).Row - letzteA - 1
              If zeile > 1 Then
               For i = 2 To zeile Step 2
                wksZ.Cells(letzteA + 1 + i, 2).Resize(1, 6).Interior.ColorIndex = 39
                wksZ.Cells(letzteA + 1 + i, 2).Resize(1, 6).Font.Size = 8
               Next
              End If
            .AutoFilter
      End With
      zaehler = 1
  End If
 End If
Next
wksZ.Columns("E:G").HorizontalAlignment = xlCenter
Range("B2").Select
End Sub
Könnte es sein, dass der Fehler hier liegt:

Code:

 .AutoFilter Field:=1, Criteria1:=">=" & CDbl(Date), Operator:=xlAnd
Ich habe den Fehler leider nicht gefunden.

Vielen Dank für eure Mühe im Voraus.

Lg
Alberto
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.04.2017, 09:02   #13
hary
MOF Guru
MOF Guru
Standard

Moin
Versuch mal Filtern nach Tagesdatum und nicht groesser/gleich.
also statt
Code:

.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Date), Operator:=xlAnd
nimm mal
Code:

.AutoFilter Field:=1, Criteria1:="=" & CDbl(Date), Operator:=xlAnd
gruss hary
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 22.04.2017, 12:39   #14
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ciao hary,

vielen Danke für deine Antwort.
Bin leider erst jetzt wieder dazu gekommen mir das in Ruhe anzuschauen.

Dein Code hat bei mir aus irgendeinem Grund auch immer leider nicht funktioniert.

Ich habe den Code aber in den folgenden umgeändert:

Code:

.AutoFilter Field:=1, Criteria1:="<=" & CDbl(Date), Operator:=xlAnd, _
                               Criteria2:=">=" & CDbl(Date)
und so hat es geklappt.

Jedoch ist bei mir nun das Problem, dass er es mir farblich nicht mehr so schön darstellt und ich habe keine Ahnung wieso.
Ich werde mir das in Ruhe nochmal anschauen und mich dann ggf. nochmal meden, wenn ich es nicht hinbekommen sollte.
Würde dann wieder eine Beispieldatei hochladen.
Angehängte Grafiken
Dateityp: jpg In der Beispieldatei.JPG (57,2 KB, 4x aufgerufen)
Dateityp: jpg In der richtigen Datei.JPG (71,2 KB, 4x aufgerufen)
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.10.2018, 18:43   #15
PanteraNera
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ciao zusammen,

nach langer Zeit und mit mehreren Monaten Pause, habe ich es nun endlich geschafft meine Fussballdatenbank mit mehreren Ligen zu beenden.
Ohne eure Hilfe ( sowohl mit Formeln als auch mit VBA ) wäre dieses Projekt nie fertig geworden und aus diesem Grunde möchte ich mich erstmal bei allen bedanken, die mir dabei geholfen haben. Vielen Dank nochmal dafür.

Jedoch würde ich gerne noch eine kleine Änderung haben und hoffe, dass ihr mir dabei wieder so toll behilflich sein könnt.

In diesem Thread ging es darum, mir alle Spiele vom aktuellen Tag anzeigen zu lassen und mit der Hilfe von hary hat dies auch super geklappt.

Nun würde ich das gerne so haben, dass wenn ich auf dieser Seite ( Spiele des Tages ) alle Ergebnisse eintrage und dann auf einen Aktualisieren Button klicke, er mir alle Ergebnisse dorthin kopiert.
Sprich, er müsste das Tabellenblatt für die Liga suchen und das aktuelle Spiel und dann da das Ergebnis eintragen.

Ist dies möglich?
Ich hoffe, dass ich es verständlich erklärt habe und habe nochmal eine Beispieldatei mit beigefügt.

Vielen Dank schon mal für eure Hilfe.

LG
Alberto
Angehängte Dateien
Dateityp: xls wenn heutiges Datum.xls (56,0 KB, 9x aufgerufen)
PanteraNera ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:55 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.