C
Cheetah1337
Gast
Servus,
Ich hätte ein für die Arbeit an sich sehr praktisches Makro geschrieben, lediglich spießt es sich hierbei an dem Umstand, dass das File auf dem Sharepoint liegt und es mehrere Kollegen+In (ich hasse allgemeines Gendern, aber in diesem Fall gibt es tatsächlich EINE "In" ^^) gleichzeitig offen haben.
Sonstige Makros, welche lediglich ein bestimmtes Objekt einfügen oder ähnliches führen zu keinen Problemen, jedoch scheinen multiple schnelle Operationen mit Datenänderungen (auch in einem zur Zeit der Ausführung definitiv nicht anderweitig in Verwendung befindlichen Tabellenblatt) die anderen Teilnehmer+In zu desynchronisieren. Sie bekommen dann oben ein Insert im Excel, dass sie das File "Erneut laden" sollen ... den genauen Wortlaut habe ich jetzt nicht parat, aber der Button lautet eben "Erneut laden".
Ich habe bereits versucht dies zu umgehen, indem ich das autosync-feature für die Dauer der Ausführung deaktiviere, jedoch fruchtete dies nicht.
Hat hiermit jemand Erfahrungen?
Kann man das Entgleisen der Kollegen unterbinden?
Leider gibt es hier offenbar für EXCEL-VBA kein Syntax-Highlighting. Aber jo die Zeilen mit den ' sind Kommentare oder auskommentiert. ^^
LG Cheetah
Ich hätte ein für die Arbeit an sich sehr praktisches Makro geschrieben, lediglich spießt es sich hierbei an dem Umstand, dass das File auf dem Sharepoint liegt und es mehrere Kollegen+In (ich hasse allgemeines Gendern, aber in diesem Fall gibt es tatsächlich EINE "In" ^^) gleichzeitig offen haben.
Sonstige Makros, welche lediglich ein bestimmtes Objekt einfügen oder ähnliches führen zu keinen Problemen, jedoch scheinen multiple schnelle Operationen mit Datenänderungen (auch in einem zur Zeit der Ausführung definitiv nicht anderweitig in Verwendung befindlichen Tabellenblatt) die anderen Teilnehmer+In zu desynchronisieren. Sie bekommen dann oben ein Insert im Excel, dass sie das File "Erneut laden" sollen ... den genauen Wortlaut habe ich jetzt nicht parat, aber der Button lautet eben "Erneut laden".
Ich habe bereits versucht dies zu umgehen, indem ich das autosync-feature für die Dauer der Ausführung deaktiviere, jedoch fruchtete dies nicht.
Code:
Sub COLOR_SEARCH()
'Makro für Zusammenfassung von Projekten anhand eines Suchbegriffs (zum Zwecke der Übersichtlichkeit)
Dim Suchbegriff As String
Dim i As String
Dim x As Integer
Dim Zeile As Integer
Dim Spalte As Integer
Dim Lastrow As Integer
x = 1
'Abfragen von Suchbegriff für Projekzusammenfassung (je genauer, desto besser)
Suchbegriff = InputBox("Suchbegriff?", "Eingabeaufforderung", "")
'Fängt "Abbruch" und leere Eingabe ab
If StrPtr(Suchbegriff) = 0 Or Suchbegriff = NullString Then
Exit Sub
End If
'Bildaufbau stoppen (für schnellere und optisch sauberere Makroausführung)
' ActiveWorkbook.AutoSaveOn = False
Application.ScreenUpdating = False
Worksheets("PROJEKTÜBERSICHT").Activate
ActiveSheet.Unprotect
' Eingegebenen Suchbegriff optisch repräsentieren
Cells(1, 1).Value = "Suchbegriff: " & Suchbegriff
' Index der letzten Reihe für die leere Tabelle definieren
Lastrow = 2
' Etwaige Daten von alten Suchanfragen löschen
Range("A2:M1500").Select
Selection.Delete Shift:=xlToLeft
Worksheets("KALENDER 2021").Activate
' Cursor auf erste Zelle des definierten Suchbereiches setzen für eine Chronologische Abfolge der Ergebnisse
Range("CC1").Activate
' Starten der Suche in der definierten Matrix "PARTIEN"
Range("PARTIEN").Find(What:=Suchbegriff, After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
' Zelladresse von erstem Suchergebnis abspeichern um eine Abbruchbedingung zu haben
i = ActiveCell.Address
' Starten von Basisroutine (Begrenzt auf 500 Durchläufe, da bei bestimmten Eingaben die Runtime zu stark anwachsen würde und man nicht all diese Eingaben abfangen kann)
While x < 500:
' "Nullpunkt" definieren
Zeile = ActiveCell.Row
Spalte = ActiveCell.Column
Worksheets("PROJEKTÜBERSICHT").Activate
With Worksheets("KALENDER 2021")
' Durch Nullpunkt-Referenz bestimmte Ranges in die Ausgabetabelle kopieren
.Range(.Cells(Zeile, 3), .Cells(Zeile + 1, 3)).COPY Destination:=Worksheets("PROJEKTÜBERSICHT").Range("A" & Lastrow)
.Range(.Cells(1, Spalte), .Cells(1, Spalte + 5)).COPY Destination:=Worksheets("PROJEKTÜBERSICHT").Range("B" & Lastrow)
.Range(.Cells(Zeile, Spalte), .Cells(Zeile + 1, Spalte + 5)).COPY Destination:=Worksheets("PROJEKTÜBERSICHT").Range("H" & Lastrow)
End With
' Zeilenumbruch für Ausgabetabelle
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2
x = x + 1
Worksheets("KALENDER 2021").Activate
Range("PARTIEN").FindNext(After:=ActiveCell).Activate
If ActiveCell.Address = i Then
Worksheets("PROJEKTÜBERSICHT").Activate
' Bedingte Formatierung setzen um doppelte Werte anzuzeigen (Intern interessant)
Range("A2:A1500").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
' ActiveWorkbook.AutoSaveOn = True
Application.ScreenUpdating = True
Range("A2").Activate
ActiveSheet.Protect
Exit Sub
End If
Wend
End SubHat hiermit jemand Erfahrungen?
Kann man das Entgleisen der Kollegen unterbinden?
Leider gibt es hier offenbar für EXCEL-VBA kein Syntax-Highlighting. Aber jo die Zeilen mit den ' sind Kommentare oder auskommentiert. ^^
LG Cheetah
