AW: Tabellenaufbau?
01.04.2013 13:30:50
Klaus
Hi Judith,
dies Makro sollte das gewünschte Erbringen (und noch etwas mehr).
Falls noch eine Aufgabe fehlt, soll sie ergänzt werden.
Ich konnte mir nicht vorstellen, dass die Angaben einfach drunter geschrieben werden sollen ... dann müsste man ja gar nichts mehr selber putzen, sondern einfach den Knopf drücken :-)
Darum hab ich die fehlenden als MsgBox zusammen gefasst. Unten kannst du ja statt MsgBox sonstwas mit den Daten anstellen.
(es wird nur ein einziger Wochentag eingetragen)
Das nehme ich als Gesetz! Das Makro checkt den Wochentag nur einmal, und zwar den aus der Zelle "Bewegungsdaten!C2". In den anderen Zellen von Bewegungsdaten!C3:Cxxx kann sonstwas stehen, Wochentage oder Börsenkurse oder Psalmen aus der Bibel - es wird vom Makro nicht beachtet.
Option Explicit
Sub WasFehltNoch()
Dim iColHelp As Integer
Dim wksDaten As Worksheet
Dim wksBeweg As Worksheet
Dim lRow As Long
Dim r As Range
Dim sMsg As String
Dim rMsg As Boolean
Dim rMsg2 As Boolean
iColHelp = 10 'Hilfsspalte J ist (hoffentlich) leer, sonst verschieben
Set wksDaten = Sheets("Datenstamm")
Set wksBeweg = Sheets("Bewegungsdaten")
rMsg = False
With wksBeweg
'letzte Zeile
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Hilfsspalte erzeugen
.Range(.Cells(2, iColHelp), .Cells(lRow, iColHelp)).FormulaR1C1 = "=RC1&""#""&RC2"
End With
With wksDaten
'Autofilter reset (Makro fehlerhaft bei gesetztem Autofilter!)
Call DoResetAutofilter(wksDaten, 1, 4, 1)
'letzte Zeile
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Hilfsspalte erzeugen
.Range(.Cells(2, iColHelp), .Cells(lRow, iColHelp)).FormulaR1C1 = "=IF(RC3=Bewegungsdaten! _
R2C3,RC1&""#""&RC2,"""")"
For Each r In .Range(.Cells(2, iColHelp), .Cells(lRow, iColHelp))
If r.Value = "" Then
Else
'prüfen, ob es bereits vorkommt
If Application.WorksheetFunction.CountIf(wksBeweg.Cells(1, iColHelp).EntireColumn, _
r.Value) = 0 Then
'Einleitungssatz nur einmal
If Not rMsg Then sMsg = "Folgende Aktivitäten fehlen heute noch:" & Chr(10)
'abschließende MsgBox aktivieren
rMsg = True
'Text in MsgBox eintragen
sMsg = sMsg & .Cells(r.Row, 1).Value & " " & .Cells(r.Row, 2).Value & Chr(10)
End If
End If
Next r
End With
With wksBeweg
If rMsg Then sMsg = sMsg & Chr(10)
rMsg2 = True
'letzte Zeile
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each r In .Range(.Cells(2, iColHelp), .Cells(lRow, iColHelp))
If r.Value = "" Then
Else
'prüfen, ob es bereits vorkommt
If Application.WorksheetFunction.CountIf(wksDaten.Cells(1, iColHelp).EntireColumn, _
r.Value) = 0 Then
'Einleitungssatz nur einmal
If rMsg2 Then sMsg = sMsg & "Folgende Daten wurden zuviel eingetragen:" & Chr( _
10)
rMsg2 = False
'abschließende MsgBox aktivieren
rMsg = True
'Text in MsgBox eintragen
sMsg = sMsg & .Cells(r.Row, 1).Value & " " & .Cells(r.Row, 2).Value & Chr(10)
End If
End If
Next r
End With
'Hilfsspalten aufräumen
wksBeweg.Cells(1, iColHelp).EntireColumn.ClearContents
wksDaten.Cells(1, iColHelp).EntireColumn.ClearContents
'MsgBox anzeigen
If rMsg Then
MsgBox sMsg
Else
MsgBox ("Alle Aktivitäten vollständig ausgeführt")
End If
End Sub
'****AUTOFILTER MAKRO *****
Sub DoResetAutofilter(wksMySheet As Worksheet, iColFirst As Integer, iColLast As Integer, _
lRowFirst As Long)
'* in case a user used another autofiler, this makro resets the autofilter to where needed.
Dim lRowLast As Long
With wksMySheet
lRowLast = .Cells(.Rows.Count, iColFirst).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter 'Turns OFF Autofilter, if any
.Range(.Cells(lRowFirst, iColFirst), .Cells(lRowLast, iColLast)).AutoFilter 'Turns ON _
Autofilter on given range
End With
End Sub
Grüße,
Klaus M.vdT.