Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
704to708
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
704to708
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

An Beni

An Beni
03.12.2005 16:03:41
achim
Hallo Beni
leider sind unsere beiträge nicht mejr im forum von daher schreibe ich nochmal
neu.
und zwar setzte ich auf den letzten stand der dikusionen auf.
mir geht es bei dem makro um folgendes:
die dienstnummer wird aus der tab. dienst 2 mal vergeben.
dabei schaut das makro nach Wochentag(MO.DI usw.) ,Dienstlage(1 oder 2).
nun meine Bitte: kann das makro auch bei der ersten vergabe der dienstnummer Tab. Einteiler nach dem datum schauen diese sich merken und dann nach gleichen datum unter der beachtung gleicher Wochentag,Dienstlage dann die dienstnummer ein zweites mal vergeben.
wenn das so ginge dann ist sichergestellt das immer zwie mitarbeiter den gleichen dienst haben und in einer gleichen gruppe eingeteil sind,(Sicherheitsdienst thema paargruppenbildung)
Beni
ich hoffe du hast noch lust dazu und geduld mir diese hilfe zu kommen zu lassen.
gruß
achim h.

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

Betreff
Datum
Anwender
Anzeige
AW: An Beni
03.12.2005 21:10:18
Beni
Hallo Achim
ich begreiffe es nicht wie Du das meinst, wie kann ich am gleichen Datum zwei Dienste vergeben.
Gruss Beni
MV36 0 21 1 DO Dezember 36119 1
MV36 0 21 2 FR Dezember 36125 1
MV36 0 21 3 SA Dezember F F
MV36 0 21 4 SO Dezember F F
MV36 0 21 5 MO Dezember 36101 1
AW: An Beni
achim
Hallo Beni
danke für die rückmeldung
ich habe ein beispiel erstellt und denke dann kommst du besser klar-
https://www.herber.de/bbs/user/28942.xls
gruß
achim h.
Anzeige
AW: An Beni
04.12.2005 21:58:27
Beni
Hallo Achim,
ich hoffe es entspriche Deiner Vorstellung.
Gruss Beni


Sub Uebereinstimmung()
' 04.12.2005 von Bernhard Mächler
Application.ScreenUpdating = False
Dim ws1, ws2 As Worksheet
Set ws1 = Sheets("Einteiler")
Set ws2 = Sheets("Dienste")
Dim z, r As Integer
lz = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'----------------------------------------------------
For z = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
    If IsNumeric(ws1.Cells(z, 23)) Then
        ws1.Cells(z, 23) = CInt(ws1.Cells(z, 23))
    End If
Next z
'----------------------------------------------------
    For z = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        For r = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
         If ws1.Cells(z, 5) = ws2.Cells(r, 10) _
        And ws1.Cells(z, 10) = ws2.Cells(r, 6) _
        And ws1.Cells(z, 23) = ws2.Cells(r, 7) _
        And ws1.Cells(z, 12) = "" Then
        If Not WorksheetFunction.CountIf(Range(ws1.Cells(2, 12), ws1.Cells(lz, 12)), ws2.Cells(r, 1)) = 2 Then
            ws1.Cells(z, 12) = ws2.Cells(r, 1)
            If Not WorksheetFunction.CountIf(Range(ws1.Cells(2, 12), ws1.Cells(lz, 12)), ws2.Cells(r, 1)) = 2 Then
           dat = ws1.Cells(z, 9)
            Set d = ws1.Columns(9).Find(What:=dat, After:=ws1.Cells(z, 9), LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not d Is Nothing Then
            a = d.Row
            If ws1.Cells(a, 12) = "" Then ws1.Cells(a, 12) = ws2.Cells(r, 1)
            End If
            End If
            Exit For
            End If
        End If
        Next r
    Next z
Application.ScreenUpdating = True
End Sub

Anzeige
Super einen kleinen wunsch noch bitte
05.12.2005 11:08:22
achim
Hallo Beni
danke für die rückmeldung!!!
Super!!!!
das makro entspricht genau meinen vorstellungen.
eine frage hätte ich noch:-)....geht das auch das er nur MV36 ab arbeitet.
wenn das ginge dann brauche nur noch bei bedarf anpassen und könnte die automatische disposition für jedes team über einen eigen button steuern.
danke
achim h.
PS.: wie kann ich mich erkenntlich zeigen. hast du eine idee?
AW: An Beni
05.12.2005 12:02:08
achim
Hallo Beni
habe jetzt länger getestet und manchmal passt es und in nicht weinigen fällen sieht das ergebnis sieht dann so aus.
MV36 1 DO Dezember 36210 06:00 - 14:12
MV36 8 DO Dezember 36210 06:00 - 14:12
das ergebis sollte aber so aussehen:
M Beni 2871 MV36 14 MI Dezember 36175 06:00 - 14:12
H Achim 1703 MV36 14 MI Dezember 36175 06:00 - 14:12
kannst du noch mal schauen, bitte.
gruß
achim h.
Anzeige
AW: An Beni
05.12.2005 20:05:06
Beni
Hallo Achim,
ich hoffe jetzt klappt, sonnst melde Dich wieder, aber morgen Abend habe ich keine Zeit.
Gruss Beni


Sub Uebereinstimmung()
' 05.12.2005 von Bernhard Mächler
Application.ScreenUpdating = False
Dim ws1, ws2 As Worksheet
Set ws1 = Sheets("Einteiler")
Set ws2 = Sheets("Dienste")
Dim a, z, r, lz As Integer
lz = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'----------------------------------------------------
For z = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
    If IsNumeric(ws1.Cells(z, 23)) Then
        ws1.Cells(z, 23) = CInt(ws1.Cells(z, 23))
    End If
Next z
'----------------------------------------------------
    For z = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        For r = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
         If ws1.Cells(z, 5) = ws2.Cells(r, 10) _
         And ws1.Cells(z, 5) = "MV36" And ws2.Cells(r, 10) = "MV36" _
        And ws1.Cells(z, 10) = ws2.Cells(r, 6) _
        And ws1.Cells(z, 23) = ws2.Cells(r, 7) _
        And ws1.Cells(z, 12) = "" Then
        If Not WorksheetFunction.CountIf(Range(ws1.Cells(2, 12), ws1.Cells(lz, 12)), ws2.Cells(r, 1)) > 1 Then
            ws1.Cells(z, 12) = ws2.Cells(r, 1): PersNr = ws1.Cells(z, 4)
            If Not WorksheetFunction.CountIf(Range(ws1.Cells(2, 12), ws1.Cells(lz, 12)), ws2.Cells(r, 1)) > 1 Then
           dat = ws1.Cells(z, 9)
            Set d = ws1.Columns(9).Find(What:=dat, After:=ws1.Cells(z, 9), LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not d Is Nothing Then
            a = d.Row
            If ws1.Cells(a, 12) = "" And Not ws1.Cells(a, 4) = PersNr Then ws1.Cells(a, 12) = ws2.Cells(r, 1)
            End If
            End If
            Exit For
            End If
        End If
        Next r
    Next z
Application.ScreenUpdating = True
End Sub
Anzeige
AW: An Beni
06.12.2005 18:03:35
achim
Hallo Beni
Danke für die Rückmeldung.
Nun es ist vollbracht. :-)habe getestet und nun läuft die Sache rund.:-)
Ich möchte mich für deine tatkräftige Unterstützung bedanken.:-):-)
Mein Angebot steht natürlich mich irgendwie erkenntlich zu zeigen:-)
Gruß
aus dem Ruhrgebiet
Achim h.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige