我正在嘗試找出在 excel 中執行日常任務的最佳方法。我有一個包含如下列的excel檔案，需要不時更新
ID country department expense_group Amount approvers1 approvers2
列批準者 1 和 2 包含逗號分隔的用戶 ID 串列 - 被授權批準給定費用的用戶，最高可達“金額”。
隨著人們離開公司、跨部門移動、新人加入，Excel 資料會手動更新。我正在尋找最好使用一些 VBA / PowerQuery 來簡化此任務的方法。
我正在尋找在 excel 中執行以下任務的方法。到目前為止，我認為唯一的方法是使用 VBA，但想聽聽任何其他可能的方法
- 針對某個費用組/部門，將某個用戶 ID 替換為另一個用戶 ID
- 針對某個費用組/部門，在逗號分隔串列中附加某個用戶 ID
- 僅在存在另一個給定用戶 ID 的情況下將某個用戶 ID 附加到逗號分隔串列中
歡迎您提出建議。
uj5u.com熱心網友回復：
如果我對上述評論的假設是正確的，請測驗下一個代碼：
Sub updateUsers(rngProc As Range, strUser, strGroup As String, Optional strReplace As String, Optional userPrezent As String)
Dim arr, arrApp1() As String, arrApp2() As String, mtch, i As Long
arr = rngProc.Columns("D:G").Value2
For i = 1 To UBound(arr)
If arr(i, 1) = strGroup Then 'strReplace <> ""
arrApp1 = Split(Replace(arr(i, 3), " ", ""), ",")
arrApp2 = Split(Replace(arr(i, 4), " ", ""), ",")
If strReplace <> "" Then
'check in approvesrs1:
mtch = Application.match(strUser, arrApp1, 0)
If IsNumeric(mtch) Then 'if strReplace does not exist
If Not userExists(strReplace, CStr(arr(i, 3))) Then
arrApp1(mtch - 1) = strReplace 'it replaces strUser
Else 'only eliminates strUser
arrApp1(mtch - 1) = arrApp1(mtch - 1) & "#$@"
arrApp1 = Sort(arrApp1, arrApp1(mtch - 1) & "#$@", False)
End If
arr(i, 3) = Join(arrApp1, ",")
End If
'check in approvesrs2:
mtch = Application.match(strUser, arrApp2, 0)
If IsNumeric(mtch) Then 'if strReplace does not exist
If Not userExists(strReplace, CStr(arr(i, 4))) Then
arrApp2(mtch - 1) = strReplace 'it replaces strUser
Else 'only eliminates strUser
arrApp2(mtch - 1) = arrApp2(mtch - 1) & "#$@"
arrApp2 = Sort(arrApp2, arrApp2(mtch - 1) & "#$@", False)
End If
arr(i, 3) = Join(arrApp1, ",")
End If
ElseIf userPrezent <> "" Then
'Appending only if a user name (userPrezent) exists:
'check in approvesrs1:
mtch = Application.match(userPrezent, arrApp1, 0)
If IsNumeric(mtch) Then
If Not userExists(strUser, CStr(arr(i, 3))) Then
arr(i, 3) = arr(i, 3) & "," & strUser 'append it only if strUser does not exist
End If
End If
'check in approvesrs2:
mtch = Application.match(userPrezent, arrApp2, 0)
If IsNumeric(mtch) Then
If Not userExists(strUser, CStr(arr(i, 4))) Then
arr(i, 4) = arr(i, 4) & "," & strUser 'append it only if strUser does not exist
End If
End If
Else
'appending without any condition
If Not userExists(strUser, CStr(arr(i, 3))) Then
arr(i, 3) = arr(i, 3) & "," & strUser 'append it only if strUser does not exist
End If
If Not userExists(strUser, CStr(arr(i, 4))) Then
arr(i, 4) = arr(i, 4) & "," & strUser 'append it only if strUser does not exist
End If
End If
End If
Next i
rngProc.Columns("D:G").Value2 = arr
End Sub
Function userExists(strUsers As String, strUser) As Boolean
Dim arr() As String, mtch As Variant
arr = Split(Replace(strUsers, " ", ""), ",")
mtch = Application.match(strUser, arr, 0)
userExists = IsNumeric(mtch)
End Function
要處理的范圍應放在 A:G 列中。
上面的代碼還檢查用戶是否被附加，或者替換現有的用戶是否已經存在，并且只有在不存在時才添加它。
我使用通用用戶、組進行了一些測驗，如“user1”、“user2”等和“group1”、“group2”等。
您可以以相同的方式繼續（在虛擬作業簿上）或使用您的真實用戶/組名并在下一個測驗子中更改它們：
Sub testUpdateUsers()
Dim sh As Worksheet, lastR As Long, rngProc As Range
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
Set rngProc = sh.Range("A2:G" & lastR)
updateUsers rngProc, "user9", "group4", "user10" 'replace "user10" with "user9", for "group4"
Stop 'see the replacement and press F5
updateUsers rngProc, "user9", "group4", , "user1" 'append "user10" in "group4" if "user1" alredy exists
Stop 'see the replacement and press F5
updateUsers rngProc, "user13", "group4" 'append "user10" in "group4"
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/518027.html
標籤：擅长vba