per Schaltfläche doppelte Werte finden
19.08.2020 09:46:50
Alex
bin neu hier im Forum, Grüße an alle, mit VBA und Makroaufzeichnung bin ich gerade erst ein wenig am tüffteln und hoffe ihr könnt mir bei meinem Problem helfen.
Ich habe einen Schichtplan, in dem ich eine doppelte Einplanung der Mitarbeiter in einer Spalte prüfen und hervorheben möchte. Über die komplette Spalte kann ich nicht gehen, da vor jeder Schichtgruppe die Wochentage stehen, diese farblich markiert für Früh-, Spät-, Nacht- und Freischicht sind und diese somit mehrfach in der Spalte vorkommen. Ich wollte erst mit bedingter Formatierung arbeiten, das schlägt aber fehl, da die Schichtleiter per drag and drop die Mitarbeiter hin und her ziehen und mir somit die Bezüge zerschießen. Aus diesem Grund wollte ich, wenn sie mit ihrer Schichtplanung fertig sind, über eine Schaltfläche mit Makro die betroffenen Zellen in einer Spalte markieren und auswerten lassen.
Ich bekomme immer die Fehlermeldung Laufzeitfehler '1004'
Ich hänge Euch mal das Programm aus dem VBA mit an. Ich hoffe meine Idee lässt sich überhaupt umsetzen.
Sub Prüfung()
' Prüfung Makro
Range("C3:C7,C13:C16,C18:C19,C21:C24,C26:C33,C35:C44,C50:C51,C53:C56,C58:C63,C65:C67,C69:C71, _
C73:C74,C76:C77,C79:C80,C82:C84,C86:C87,C89:C91,C97:C100,C102:C103,C105:C108,C110:C117,C119:C128,C134:C135,C137:C140,C142:C147,C149:C151,C153:C155,C157:C158,C160:C161,C163:C164,C166:C168,C170:C175,C181:C184,C186:C187,C189:C192,C194:C201,C203:C212,C218:C219,C221:C224,C226:C231,C233:C235,C237:C239,C241:C242,C244:C245,C247:C248,C250:C252,C254:C255,C257:C259,C265:C268,C270:C271,C273:C276,C278:C285,C287:C296,C302:C303,C305:C308,C310:C315,C317:C319,C321:C323,C325:C326,C328:C329,C331:C332,C334:C336,C338:C339,C341:C343").Select
Range("D3:D7,D13:D16,D18:D19,D21:D24,D26:D33,D35:D44,D50:D51,D53:D56,D58:D63,D65:D67,D69: _
D71,D73:D74,D76:D77,D79:D80,D82:D84,D86:D87,D89:D91,D97:D100,D102:D103,D105:D108,D110:D117,D119:D128,D134:D135,D137:D140,D142:D147,D149:D151,D153:D155,D157:D158,D160:D161,D163:D164,D166:D168,D170:D175,D181:D184,D186:D187,D189:D192,D194:D201,D203:D212,D218:D219,D221:D224,D226:D231,D233:D235,D237:D239,D241:D242,D244:D245,D247:D248,D250:D252,D254:D255,D257:D259,D265:D268,D270:D271,D273:D276,D278:D285,D287:D296,D302:D303,D305:D308,D310:D315,D317:D319,D321:D323,D325:D326,D328:D329,D331:D332,D334:D336,D338:D339,D341:D343").Select
Range("E3:E7,E13:E16,E18:E19,E21:E24,E26:E33,E35:E44,E50:E51,E53:E56,E58:E63,E65:E67,E69: _
E71,E73:E74,E76:E77,E79:E80,E82:E84,E86:E87,E89:E91,E97:E100,E102:E103,E105:E108,E110:E117,E119:E128,E134:E135,E137:E140,E142:E147,E149:E151,E153:E155,E157:E158,E160:E161,E163:E164,E166:E168,E170:E175,E181:E184,E186:E187,E189:E192,E194:E201,E203:E212,E218:E219,E221:E224,E226:E231,E233:E235,E237:E239,E241:E242,E244:E245,E247:E248,E250:E252,E254:E255,E257:E259,E265:E268,E270:E271,E273:E276,E278:E285,E287:E296,E302:E303,E305:E308,E310:E315,E317:E319,E321:E323,E325:E326,E328:E329,E331:E332,E334:E336,E338:E339,E341:E343").Select
Range("F3:F7,F13:F16,F18:F19,F21:F24,F26:F33,F35:F44,F50:F51,F53:F56,F58:F63,F65:F67,F69: _
F71,F73:F74,F76:F77,F79:F80,F82:F84,F86:F87,F89:F91,F97:F100,F102:F103,F105:F108,F110:F117,F119:F128,F134:F135,F137:F140,F142:F147,F149:F151,F153:F155,F157:F158,F160:F161,F163:F164,F166:F168,F170:F175,F181:F184,F186:F187,F189:F192,F194:F201,F203:F212,F218:F219,F221:F224,F226:F231,F233:F235,F237:F239,F241:F242,F244:F245,F247:F248,F250:F252,F254:F255,F257:F259,F265:F268,F270:F271,F273:F276,F278:F285,F287:F296,F302:F303,F305:F308,F310:F315,F317:F319,F321:F323,F325:F326,F328:F329,F331:F332,F334:F336,F338:F339,F341:F343").Select
Range("G3:G7,G13:G16,G18:G19,G21:G24,G26:G33,G35:G44,G50:G51,G53:G56,G58:G63,G65:G67,G69: _
G71,G73:G74,G76:G77,G79:G80,G82:G84,G86:G87,G89:G91,G97:G100,G102:G103,G105:G108,G110:G117,G119:G128,G134:G135,G137:G140,G142:G147,G149:G151,G153:G155,G157:G158,G160:G161,G163:G164,G166:G168,G170:G175,G181:G184,G186:G187,G189:G192,G194:G201,G203:G212,G218:G219,G221:G224,G226:G231,G233:G235,G237:G239,G241:G242,G244:G245,G247:G248,G250:G252,G254:G255,G257:G259,G265:G268,G270:G271,G273:G276,G278:G285,G287:G296,G302:G303,G305:G308,G310:G315,G317:G319,G321:G323,G325:G326,G328:G329,G331:G332,G334:G336,G338:G339,G341:G343").Select
Range("H3:H7,H13:H16,H18:H19,H21:H24,H26:H33,H35:H44,H50:H51,H53:H56,H58:H63,H65:H67,H69: _
H71,H73:H74,H76:H77,H79:H80,H82:H84,H86:H87,H89:H91,H97:H100,H102:H103,H105:H108,H110:H117,H119:H128,H134:H135,H137:H140,H142:H147,H149:H151,H153:H155,H157:H158,H160:H161,H163:H164,H166:H168,H170:H175,H181:H184,H186:H187,H189:H192,H194:H201,H203:H212,H218:H219,H221:H224,H226:H231,H233:H235,H237:H239,H241:H242,H244:H245,H247:H248,H250:H252,H254:H255,H257:H259,H265:H268,H270:H271,H273:H276,H278:H285,H287:H296,H302:H303,H305:H308,H310:H315,H317:H319,H321:H323,H325:H326,H328:H329,H331:H332,H334:H336,H338:H339,H341:H343").Select
Range("I3:I7,I13:I16,I18:I19,I21:I24,I26:I33,I35:I44,I50:I51,I53:I56,I58:I63,I65:I67,I69: _
I71,I73:I74,I76:I77,I79:I80,I82:I84,I86:I87,I89:I91,I97:I100,I102:I103,I105:I108,I110:I117,I119:I128,I134:I135,I137:I140,I142:I147,I149:I151,I153:I155,I157:I158,I160:I161,I163:I164,I166:I168,I170:I175,I181:I184,I186:I187,I189:I192,I194:I201,I203:I212,I218:I219,I221:I224,I226:I231,I233:I235,I237:I239,I241:I242,I244:I245,I247:I248,I250:I252,I254:I255,I257:I259,I265:I268,I270:I271,I273:I276,I278:I285,I287:I296,I302:I303,I305:I308,I310:I315,I317:I319,I321:I323,I325:I326,I328:I329,I331:I332,I334:I336,I338:I339,I341:I343").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = True
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Danke und beste Grüße
Alex