Thema Datum  Von Nutzer Rating
Antwort
01.05.2014 11:45:54 ben
NotSolved
01.05.2014 13:40:57 Gast32589
NotSolved
Rot Tickettool mit Hilfe von Excel VBA realisieren
11.05.2014 21:00:16 ben
NotSolved

Ansicht des Beitrags:
Von:
ben
Datum:
11.05.2014 21:00:16
Views:
873
Rating: Antwort:
  Ja
Thema:
Tickettool mit Hilfe von Excel VBA realisieren

Hallo zusammen,

 

habe bereits einiges realisieren können. Jedoch besteht leider immer noch ein Problem, welches ich nicht zu Lösen vermag.

 

Ich möchte die Tickets, welche erledigt wurden, das heißt nach aktualisieren nicht mehr in der Datenbank vorhanden sind, in einen extra Reiter kopieren lassen. Kann mir jemand dabei helfen?

'Refresh-Button
Function Schaltfläche1_Klicken()
Call FilterZurücksetzenMaster
Call Ticketuebersicht
Call SpaltenFormatierung
Call Referenzen
Call SortierenTicketId
End Function

'eingestellte Filter werden hier wieder zurückgesetzt
Function FilterZurücksetzenMaster()
 Dim intI As Integer
 
 With Worksheets("Masteransicht")
     For intI = 1 To 12  '"1 To 12" entspricht den Spalten A bis L
      Selection.AutoFilter Field:=intI
     Next
 End With
 
 End Function

Function Ticketuebersicht()

    'Löschen der alte Tabelle
    Range("A1:Z999").Clear
    
    'auf ServiceCenter zugreifen und neue Tabelle erzeugen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;
        , Destination:=Range("A8"))
        .Name = "Tasklist.asp?Taskstatus=2%2C10%2C12%2C9%2C40%2C7%2C22%2C30&sys_allmyroles=1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
              
    End With
    
End Function

Function SpaltenFormatierung()

    'Löschen der Spalten A und B da unnötig, und verschieben der restliche Spalten nach links
    Range("A:B").Delete
    
    'Löschung der Spalte "Re? Gruppieren"
    'Range("B:B").Delete
    
    'Definiern der Spaltenbreite der Spaltenüberschriften
    Columns("A:A").ColumnWidth = 21
    Range("A:A").HorizontalAlignment = xlCenter
    Columns("B:M").AutoFit
    
    'Formatierung der Spaltenüberschriften
    With Range("A12.M12")
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Interior.ColorIndex = 37
                    .BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
                    .AutoFilter
    End With
End Function
    
'Sortieren nach Ticket ID aufsteigend
Function SortierenTicketId()
    Sheets("Masteransicht").Range("A12:M500").Sort Key1:=Range("A12"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function

'Aufrufinformationen
Function Referenzen()
Range("C2") = "Datum"
Range("C2").Font.Bold = True
Range("D2") = Date
Range("C2:D2").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("D2").HorizontalAlignment = xlLeft
Range("C3") = "Uhrzeit"
Range("C3").Font.Bold = True
Range("C3:D3").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("D3") = Time
Range("D3").HorizontalAlignment = xlLeft
Range("C4") = "User"
Range("C4").Font.Bold = True
Range("D4") = Environ("Username")
Range("C4:D4").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("C5") = "URL"
Range("C5").Font.Bold = True
Range("D5") = "

End Function

'Button übernimmt Änderungen aus Masteransicht
Function Schaltfläche5_Klicken()
Call SortierenTicketIdAufsteigend
Call NeueTickets
Call DoppelteEinträgeLöschen
Call SortierenTicketIdAbsteigend
Call Formatierungen
Call Schaltfläche4_Klicken
End Function

'sortiert nach "Anfragen ID" aufsteigend
Function SortierenTicketIdAufsteigend()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function

 'fügt neu ankommende Tickets hinzu
 Function NeueTickets()
 i = 13 'erste Zelle mit Inhalt in "Masteransicht"
 k = 7  'erste Zeile "Tickets priorisieren" in der Inhalt aus "Masteransicht" kopiert werden soll

'Ticket IDs werden Zeile für Zeile auf Gleichheit geprüft, wenn ungleich neue Zeile in "Tickets priorisieren" einfügen
 For Each zel In Sheets("Masteransicht").Range("A13.A500")
    If Sheets("Masteransicht").Cells(i, 1).Value = Sheets("Tickets priorisieren").Cells(k, 6).Value Then
    
    i = i + 1
    k = k + 1
    
    Else
    
    letzteZeile = Sheets("Tickets priorisieren").Cells(Rows.Count, 6).End(xlUp).Row
    
    Sheets("Tickets priorisieren").Range("F" & letzteZeile + 1).Resize(1, 13) = _
    Sheets("Masteransicht").Range("A" & zel.Row).Resize(1, 13).Value
    
    i = i + 1
    k = k + 1

    
    letzteZeile = letzteZeile + 1

    End If

Next
End Function

'Löscht doppelte Einträge
 Function DoppelteEinträgeLöschen()
 Dim lngZeile As Long
 Dim lngZeilenSprung As Long
 Dim strSuchwert As String

 lngZeile = Cells(Rows.Count, 6).End(xlUp).Row
   
   For lngZeilenSprung = lngZeile To 7 Step -1
     strSuchwert = Cells(lngZeilenSprung, 6).Value
       If Application.WorksheetFunction.CountIf(Range(Cells(6, 6), Cells(lngZeile, 6)), strSuchwert) <> 1 Then
         Cells(lngZeilenSprung, 6).Resize(1, 13).Select
         Selection.Delete
       End If
   Next lngZeilenSprung

 End Function
 
'Tickets werden entsprechend ihrer Id absteigend sortiert->neue Tickets erscheinen oben
Function SortierenTicketIdAbsteigend()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 
 'Spalten A,B,F,I und N werden zentriert, bei Spalten F bis R wird Spaltenbreite automatisch festgelegt
 Function Formatierungen()
 
    Sheets("Tickets priorisieren").Range("A:B, F:F, I:I, N:N").HorizontalAlignment = xlCenter
    Sheets("Tickets priorisieren").Columns("F:R").AutoFit
 
 End Function
 
 'wird über "Schaltfläche5_Klicken" aufgerufen
 Function Schaltfläche4_Klicken()
 Call SortierenTicketIdAufsteigend2
 Call LöschenGeschlosseneTickets
 Call SortierenTicketIdAbsteigend2
 End Function

Function SortierenTicketIdAufsteigend2()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 
 'Löscht bereits geschlossene Tickets aus Tabelle "Tickets priorisieren"
Function LöschenGeschlosseneTickets()
 i = 13
 k = 7
 
 'Ticket IDs werden Zeile für Zeile auf Gleichheit geprüft, wenn ungleich wird Zeile markiert und gelöscht
 For Each zel In Sheets("Tickets priorisieren").Range("A7:A500")
    If Sheets("Tickets priorisieren").Cells(k, 6).Value = Sheets("Masteransicht").Cells(i, 1).Value Then
    k = k + 1
    i = i + 1
    
    Else
    Sheets("Tickets priorisieren").Cells(k, 1).Resize(1, 18).Select '"1,18" entspricht den Spalten A bis M
    Selection.Delete
    
    k = k
    i = i
    
    End If

Next
End Function

Function SortierenTicketIdAbsteigend2()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function

 
 
 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
01.05.2014 11:45:54 ben
NotSolved
01.05.2014 13:40:57 Gast32589
NotSolved
Rot Tickettool mit Hilfe von Excel VBA realisieren
11.05.2014 21:00:16 ben
NotSolved