我撰寫了以下代碼來從服務器上的并發許可證檔案中匯入資料。下一部分我想檢查條目并找到 OUT: 條目,然后查看作業表并找到相應的 IN: 以便我可以看到該人獲得許可證多長時間。我只是不知道該怎么做。我認為如果我使用 Array 它會變得丑陋,因為其中一些日志長達數月:
Option Explicit
Sub ImportAppData(importTable, importFile)
Dim WB2 As Workbook
Dim WS2 As Worksheet
Dim lRow, lCol, x As Long
Dim preDate, postDate As Date
Dim strAPPStats() As String
Dim strTimeStamp
lCol = 3
WB1.Sheets.Add
Set WS2 = WB1.ActiveSheet
WS2.Name = "App_Logs_Import"
Set WB2 = Workbooks.Open(importFile)
WB2.Sheets(1).Cells.Copy WS2.Cells
WB2.Close False
lRow = 1
lCol = 1
Do While WS2.Cells(lRow, lCol) <> ""
If InStr(WS2.Cells(lRow, lCol), "IN:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "OUT:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") = 0 _
And InStr(WS2.Cells(lRow, lCol), "UNSUPPORTED:") = 0 _
And InStr(WS2.Cells(lRow, lCol), "DENIED:") = 0 Then
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
Else
If Left(WS2.Cells(lRow, lCol), 1) = " " Then
WS2.Cells(lRow, lCol) = LTrim(WS2.Cells(lRow, lCol))
End If
End If
lRow = lRow 1
Loop
lRow = 1
lCol = 1
Do While strTimeStamp = 0
If InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") <> 0 Then
strTimeStamp = us2ukDate(WS2.Cells(lRow, lCol))
strTimeStamp = Format$(strTimeStamp, "dd/mmm/yyyy")
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
Else
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
End If
lRow = lRow 1
Loop
Do While WS2.Cells(lRow, lCol) <> ""
If InStr(WS2.Cells(lRow, lCol), "TIMESTAMP") <> 0 Then
strTimeStamp = us2ukDate(WS2.Cells(lRow, lCol))
strTimeStamp = Format(strTimeStamp, "dd/mmm/yyyy")
WS2.Cells(lRow, lCol).EntireRow.Delete
lRow = lRow - 1
ElseIf InStr(WS2.Cells(lRow, lCol), "UNSUPPORTED:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 8 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "OUT:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "IN:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
ElseIf InStr(WS2.Cells(lRow, lCol), "DENIED:") <> 0 Then
strAPPStats = Split(WS2.Cells(lRow, lCol), " ")
For x = LBound(strAPPStats) To UBound(strAPPStats)
If x = 0 Then
WS2.Cells(lRow, lCol) = Format$(strTimeStamp & " " & strAPPStats(x), "dd/mmm/yyyy HH:MM")
lCol = lCol 1
ElseIf x = 2 Or x = 3 Or x = 4 Or x = 5 Then
WS2.Cells(lRow, lCol) = strAPPStats(x)
lCol = lCol 1
End If
Next
End If
lCol = 1
lRow = lRow 1
Loop
End Sub
我接下來要做的是添加一列,然后在作業表中查找第一個條目(OUT:),然后將其與同一用戶的 IN:(相同日期,忽略時間)條目匹配,然后移動他們都到同一行。
我要匯入的資料是:
4:39:18 (*****) TIMESTAMP 3/14/2022
8:24:12 (*****) OUT: "Application1" User1@Win10PC1
8:24:12 (*****) OUT: "Application2" User1@Win10PC1
8:49:23 (*****) OUT: "Application1" User2@Win10PC2
8:49:23 (*****) OUT: "Application2" User2@Win10PC2
8:59:40 (*****) OUT: "Application1" User3@Win10PC3
8:59:40 (*****) OUT: "Application3" User3@Win10PC3
13:39:22 (*****) IN: "Application1" User1@Win10PC1
13:39:22 (*****) IN: "Application2" User1@Win10PC1
13:53:43 (*****) OUT: "Application1" User1@Win10PC1
13:53:44 (*****) OUT: "Application2" User1@Win10PC1
14:41:53 (*****) OUT: "Application1" User3@Win10PC3
14:55:24 (*****) IN: "Application1" User3@Win10PC3
17:48:59 (*****) IN: "Application1" User2@Win10PC2
17:48:59 (*****) IN: "Application2" User2@Win10PC2
18:07:09 (*****) IN: "Application1" User3@Win10PC3
18:07:09 (*****) IN: "Application3" User3@Win10PC3
18:32:53 (*****) IN: "Application1" User1@Win10PC1
18:32:54 (*****) IN: "Application2" User1@Win10PC1
20:49:46 (*****) OUT: "Application1" User1@Win10PC1
20:49:47 (*****) OUT: "Application2" User1@Win10PC1
23:29:03 (*****) IN: "Application2" User1@Win10PC1
23:29:03 (*****) IN: "Application1" User1@Win10PC1
代碼將資料匯入作業表,如下所示:
-------------------------------------------------------------
| 14/Mar/2022 8:24 | OUT: | "Application1" | User1@Win10PC1 |
| 14/Mar/2022 8:24 | OUT: | "Application2" | User1@Win10PC1 |
| 14/Mar/2022 8:49 | OUT: | "Application1" | User2@Win10PC2 |
| 14/Mar/2022 8:49 | OUT: | "Application2" | User2@Win10PC2 |
-------------------------------------------------------------
我想要的是:
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:24 | 14/Mar/2022 13:39 | Application1 | User1@Win10PC1 |
| 14/Mar/2022 8:49 | 14/Mar/2022 17:48 | Application1 | User2@Win10PC2 |
------------------------------------------------------------------------
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:24 | 14/Mar/2022 13:39 | Application2 | User1@Win10PC1 |
| 14/Mar/2022 8:49 | 14/Mar/2022 17:48 | Application2 | User2@Win10PC2 |
------------------------------------------------------------------------
------------------------------------------------------------------------
| Out | In | Application | User |
------------------------------------------------------------------------
| 14/Mar/2022 8:59 | 14/Mar/2022 18:07 | Application3 | User3@Win10PC3 |
------------------------------------------------------------------------
TYIA
編輯:
現在發現這種情況:
8:59:40 (*****) OUT: "Application1" user2@Win10PC2
8:59:40 (*****) OUT: "Application2" user2@Win10PC2
14:41:53 (*****) OUT: "Application1" user2@Win10PC2
14:55:24 (*****) IN: "Application1" user2@Win10PC2
18:07:09 (*****) IN: "Application1" user2@Win10PC2
18:07:09 (*****) IN: "Application2" user2@Win10PC2
uj5u.com熱心網友回復:
我之前使用類似的日志檔案完成了此操作,通常更容易一次直接讀取檔案,而不是在 Excel 中打開后對其進行決議。
例如(只是處理 OUT 和 IN 以簡化,因為我不確定你在用其他標志做什么)
編輯- 為每個用戶處理同一許可證的多個結帳。
Sub ImportLog()
Const ForReading = 1
Dim f As Object, wsResults As Worksheet, dt As String, l As String, arr
Dim dict As Object, rw As Long, k, ts, app, usr, action, col As Collection
Set dict = CreateObject("scripting.dictionary") 'for tracking sheet row numbers
Set wsResults = ThisWorkbook.Sheets("Logs")
wsResults.UsedRange.Offset(1, 0).ClearContents 'leave the headers
rw = 1
dt = "{no date}" 'until we hit a TIMESTAMP line...
Set f = CreateObject("scripting.filesystemobject"). _
opentextfile("C:\Temp\log.txt", ForReading)
Do While Not f.AtEndOfStream
l = Trim(f.readline()) 'read a line
If Len(l) > 0 Then 'any data?
arr = Split(l, " ") 'split to array
If l Like "*TIMESTAMP*" Then
dt = GetDate(arr(UBound(arr))) 'pick up the date?
Else
ts = dt & " " & Trim(arr(0))
action = arr(2) 'OUT/IN/etc
app = Replace(arr(3), """", "")
usr = arr(4)
k = app & "~~" & usr 'user app combination
Select Case action
Case "OUT:" 'checking out: record info and row number
rw = rw 1
'collection allows for multiple "OUT" rows per key
If Not dict.exists(k) Then Set dict(k) = New Collection
dict(k).Add rw 'add row number for this check-out to the collection
With wsResults.Rows(rw)
.Cells(1).Value = ts 'add checkout info...
.Cells(3).Value = app
.Cells(4).Value = usr
End With
Case "IN:"
If dict.exists(k) Then 'is there a check-out for this app user?
Set col = dict(k)
wsResults.Cells(col(1), 2).Value = ts 'add the "IN" time
col.Remove 1 'remove the row we just closed from the collection
If col.Count = 0 Then dict.Remove k 'all rows closed for this key
Else
'no corresponding "out" record...
Debug.Print "No match: " & l
End If
End Select
End If 'TIMESTAMP?
End If
Loop
f.Close
'any licenses checked out but not checked in?
If dict.Count > 0 Then
Debug.Print "Unclosed checkouts"
For Each k In dict
Debug.Print , k
Next k
End If
End Sub
Function GetDate(txt)
Dim arr
arr = Split(Trim(txt), "/")
GetDate = arr(1) & "/" & arr(0) & "/" & arr(2) 'swap day/month
End Function
示例資料的輸出:您可以通過一些排序/分組來整理它

轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/488836.html
