User-Statistik für verschiedene User

Sub Statistic(Begriff As String) ' Counts entered search criteria and updates search statistics on Statistics tab Dim Eintrag As Long Dim FB As Range Dim firstAddress As String Eintrag = Worksheets("Statistics").Cells(Rows.Count, 1).End(xlUp).Row With Worksheets("Statistics").Range("A1:A" & CStr(Eintrag)) Set FB = .Find(Begriff, LookIn:=xlValues) If Not FB Is Nothing Then FB.Offset(0, 1).Value = FB.Offset(0, 1).Value + 1 Else Worksheets("Statistics").Cells(Eintrag + 1, 1).Value = Begriff Worksheets("Statistics").Cells(Eintrag + 1, 2).Value = 1 End If End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Declare Function DllRegisterServer Lib "mscal.ocx" () As Long Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Public strUserName As String

Sub Register() DllRegisterServer End Sub Sub UserName() Dim strUserName As String strUserName = String(100, Chr$(0)) retval = GetUserName(strUserName, 100) strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1) MsgBox strUserName End Sub

Hallo Jenny,
wenn Du wirklich gleichzeitig mit mehreren Usern auf das Excel-File zugreifen willst, musst Du sie freigeben. Das allerdings führt dazu, dass sich die Arbeitsmappe aufbläht und unendlich langsam wird, daher würde ich Dir davon abraten.
Mir fiele keine Grund ein, warum der Code bei einer freigegebenen Arbeitsmappe nicht funktionieren sollte, habe das aber nicht getestet.
Der untere Teil des Codes von mir bewirkt, dass in der Variable 'strUserName' der Benutzername des aktuellen Benutzers steht. Du musst ihn also in dein Makro einbinden und kannst dann mit der Variablen weiterarbeiten und den Wert evtl. in eine Zelle schreiben oder so.
Den oberen Teil musst Du in ein Modul einfügen (Projekt markieren - Einfügen - Modul)
Gruß
Frank

Hallo,
wenn die User sowieso keine Änderungen vornehmen sollen/dürfen, dann wäre es besser die Datei nur schreibgeschützt zu öffnen. Am einfachsten - Rechtsklick auf die Datei im Explorer - Eigenschaften - ganz unten bei "Schreibgeschützt" ein Häkchen setzen.
Dein Logfile kannst du so schreiben:

Option Explicit

Private Type DATASET
    strUser As String * 50
    strSearchTerm As String * 50
    lngCount As Long
End Type

Private Sub Statistic(ByVal pvstrSearchTerm As String)
    Dim intFileNumber As Integer
    Dim lngDatasetCounter As Long
    Dim strUser As String
    Dim udtDataset As DATASET
    strUser = Environ$("USERNAME")
    Reset
    intFileNumber = FreeFile
    Open ThisWorkbook.Path & "\Statistic.log" For Random _
        Access Read Write As #intFileNumber Len = Len(udtDataset)
    Do
        lngDatasetCounter = lngDatasetCounter + 1
        Get #intFileNumber, lngDatasetCounter, udtDataset
        If EOF(intFileNumber) Then
            udtDataset.strUser = strUser
            udtDataset.strSearchTerm = pvstrSearchTerm
            udtDataset.lngCount = 1
            Exit Do
        End If
        If StrComp(Trim$(udtDataset.strSearchTerm), _
            pvstrSearchTerm, vbTextCompare) = 0 Then
            If StrComp(Trim$(udtDataset.strUser), _
                strUser, vbTextCompare) = 0 Then
                udtDataset.lngCount = udtDataset.lngCount + 1
                Exit Do
            End If
        End If
    Loop
    Put #intFileNumber, lngDatasetCounter, udtDataset
    Close #intFileNumber
End Sub

Public Sub Analysis()
    Dim intFileNumber As Integer
    Dim lngRow As Long
    Dim udtDataset As DATASET
    lngRow = 1
    Reset
    intFileNumber = FreeFile
    With Worksheets("Statistics")
        With .Range("A1:C1")
            .EntireColumn.ClearContents
            .Value2 = Array("Username", "Searchterm", "Count")
            .Font.Bold = True
        End With
        Open ThisWorkbook.Path & "\Statistic.log" For Random Access _
            Read As #intFileNumber Len = Len(udtDataset)
        Do
            Get #intFileNumber, , udtDataset
            If EOF(intFileNumber) Then Exit Do
            lngRow = lngRow + 1
            .Cells(lngRow, 1).Resize(1, 3).Value2 = Array(Trim$(udtDataset.strUser), _
                Trim$(udtDataset.strSearchTerm), udtDataset.lngCount)
        Loop
        Close #intFileNumber
        .Range("A1:C1").EntireColumn.AutoFit
    End With
End Sub

Die Prozedur Analysis diehnt dazu das Logfile in die Tabelle Statistik einzulesen. Irgendwie kommt mir das wie ein Déjà-vu vor. Ein fast identische Makro habe ich erst neulich geschrieben.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

User-Statistik für verschiedene User

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread