Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1632to1636
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
Inhaltsverzeichnis

Wochentagabfrage

Wochentagabfrage
13.07.2018 15:23:07
Laura
Hallo zusammen,
ich stehe vor einem Problem, bei dem ich nicht genau weiß wie ich weiter Verfahren soll.
Ich habe eine Tabelle mit Werte, z.B. steht in Zeile Spalte A das Datum. Die Tabelle wird mittels eines Makros, anhand einer Suche nach der Kalenderwoche, aus einer anderen übergeordneten Tabelle gefüllt.
Das Problem ist, dass es vorkommen kann, dass z.B. der Montag in der übergeordneten Tabelle nicht vorhanden ist. Somit wird der Dienstag in die Zeile geschrieben wo eigentlich der Montag stehen würde.
Gibt es eine Formelkombination oder eine Möglichkeit in VBA zu prüfen: Wenn Dienstag kopiere in Zeile +1, wenn Mittwoch kopiere in Zeile +2.... wenn Samstag kopiere in Zeile +5. Das Ganze soll am besten in einer weiteren Tabelle stehen.
Vielen Dank und schöne Grüße
Laura

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wochentagabfrage
13.07.2018 15:48:44
UweD
Hallo
so?
Sub testen()
    Dim TTag As Date, ZOffset As Long
    
    TTag = "10.07.2018" 'Dienstag 
    ZOffset = WorksheetFunction.Weekday(TTag, 11) - 1  '1 = Montag 


    'oder ZOffset = WorksheetFunction.Weekday(TTag, 3)  '0 = Montag 

End Sub
LG UweD
Anzeige
AW: Wochentagabfrage
13.07.2018 16:39:03
Laura
Hallo UweD,
leider nicht.
Ich habe mal einen Screenshot einer BSPmappe angehängt mit ein paar Kommentaren.
Falls Du mir damit helfen kannst bin ich Dir sehr dankbar.
Viele Grüße und schönes We
Laura
Userbild
AW: Wochentagabfrage
13.07.2018 16:48:18
UweD
Bitte kein Bild, sondern Musterdatei.
Wir wollen auch deinen bereits existierenden Code sehen
LG UweD
AW: Wochentagabfrage
13.07.2018 19:44:41
Laura
Hallo UweD,
hab die Datei gecleant und die beiden wichtigsten Makros drin gelassen.
https://www.herber.de/bbs/user/122669.xlsm
Vg
Laura
Anzeige
AW: Wochentagabfrage
13.07.2018 22:58:52
Barbaraa
Hi Laura,
du schreibst erst, dass eine Tabelle falsch befüllt wird und legst ein Bild bei. Dieses ist in Deiner Beispieldatei nicht zu finden, auch kein Makro, das eine Tabelle befüllt.
Was willst Du eigentlich konkret?
Bitte lade eine Beispieldatei mit den RELEVANTEN Tabellen und Makros hoch, und mit dem Ergebnis, wie es aussehen sollte.
LGB
@Barbaraa
13.07.2018 23:25:29
Matthias
Hallo Barbaraa (Wirst Du wirklich mit 2 "aa" am Ende geschrieben?
Zum Thema:
Das Makro ist doch vorhanden!
Public Sub FindenUndKopieren()
Im Modul: Datum_finden
Die Daten werden in das Register: Hilfstabelle geschrieben
Klicke im Sheet "Eingabemaske auf "Fülle Hilfstabelle"
Gib einmal 27 und dann mal 28 in die Inputbox ein. Schau Dir dann das Register: Hilfstabelle an
Das die Daten der KW jetzt nicht stimmen ist erstmal 2.rangig.
Gruß Matthias
Anzeige
AW: @Barbaraa
14.07.2018 10:45:45
Laura
Hallo Matthias,
hast Du denn eine Idee für das Problem?
Ich hatte an eine Wochentagsabfrage gedaacht, die dann dafür sorgt dass die Zeilen jeweils um den richtigen Wert nach unten rutschen beim kopieren.
Vg
Laura
AW: Wochentagabfrage
14.07.2018 10:47:18
Laura
Hallo Barbaraa,
alles was benötigt wird ist in der Mappe vorhanden.
Das Bild diente lediglich als Erklärungsversuch.
Grüße
Laura
AW: Wochentagabfrage
14.07.2018 16:54:03
Laura
Hallo nochmal,
ich habe das Problem gelöst und poste den Code mal, falls jemand ein ähnliches Problem hat.
LG
Laura
PS: Der Code ist noch nicht formatiert.
Sub archivieren2()
_
Dim x As Range
Dim rng As Range
Dim sTag1 As String
Dim sTag2 As String
Dim sTag3 As String
Dim sTag4 As String
Dim sTag5 As String
Dim sTag6 As String
Worksheets("Archiv").Visible = True
sTag1 = Worksheets("KHilfstabelle").Range("A2")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag1, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag1, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A10:H10")
End If
'----------------------------------------------------------------------------------------------- _
sTag2 = Worksheets("KHilfstabelle").Range("A3")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag2, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag2, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A11:H11")
End If
'----------------------------------------------------------------------------------------------- _
sTag3 = Worksheets("KHilfstabelle").Range("A4")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag3, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag3, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A12:H12")
End If
'----------------------------------------------------------------------------------------------- _
sTag4 = Worksheets("KHilfstabelle").Range("A5")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag4, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag4, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A13:H13")
End If
'----------------------------------------------------------------------------------------------- _
sTag5 = Worksheets("KHilfstabelle").Range("A6")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag5, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag5, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A14:H14")
End If
'----------------------------------------------------------------------------------------------- _
sTag6 = Worksheets("KHilfstabelle").Range("A7")
Set x = Worksheets("Hilfstabelle").Range("C2:C7").Find(What:=sTag6, LookAt:=xlWhole, LookIn: _
=xlValues)
If x Is Nothing Then
MsgBox ("offk")
Else
_
Worksheets("Hilfstabelle").Range("A2:G7").Find(What:=sTag6, LookAt:=xlWhole, LookIn:= _
xlValues).EntireRow.Copy _
Destination:=Worksheets("KHilfstabelle").Range("A15:H15")
End If
End Sub

Anzeige
AW: Wochentagabfrage
14.07.2018 22:24:17
Barbaraa
Hallo Laura,
Dein Makro bezieht sich auf ein Blatt namens "KHilfstabelle". Eine solche ist in Deiner Beispieldatei aber nicht.
Auch wenn ich ein neues Blatt mit diesen Namen anlege, ist der eben gezeigte Code von Dir nicht ganz ergründlich.
Aber:
Wenn er für Dich funktioniert, dann hast Du Dein Ziel erreicht. Herzlichen Glückwunsch.
LGB

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige