Question

我有2个数据表，其中有三列empname和role 想要逐列比较“角色”，以检查两个工作表中的普通员工是否具有不同的角色。

我想标记异常角色（即两个表的普通员工都有不同的角色）例如数据表

表1

EmpName        EmpID        Role
Aakash C Shah   id1        user, auditor
Abdul Yasin     id2        Password Admin,Password Admin,Group Admin
Abhijit Chakre  id3        Group Admin,Password Admin
Abhijit Dixit   id4        Group Admin,DC Admin

表2

Emp Name        EmpID        Role
Aakash C Shah   id1      auditor,password Admin, DC Admin
Abdul Yasin     id2      Group Admin,Password Admin,Password Admin
Abhijit Chakre  id3      Password Admin,Group Admin
Abhijit Dixit   id5      DC Admin,Group Admin

我面临下面的问题 1）“角色”列没有发生字符串的完全匹配，因为我们可以看到具有empID id 2和id 3的员工是相同的，但由于单元格中的角色序列不同，仍然会出现例外情况。在表1中，它以密码admin开头，在表2中以组admin开头类似的情况是id 3.it应该不是例外。

异常应该是emp - Aakash C Shah with id1，因为它在两个工作表中都有不同的作用。我的方法是

将字符串拆分为数组
排序数组
字符串 - 新列（例如4）
输出应该出现表2（col4）为同一雇员。

但我正在通过宏录制进行。任何人都可以帮助vba代码至少1点和2点。

<Option Explicit

Sub compare()

Dim shtold As Worksheet, shtnew As Worksheet, shtmatch As Worksheet
Dim oldrow As Long
Dim newrow As Integer
Dim I As Integer, id, f As Range

Application.Cursor = xlDefault

          I = 2



Set shtold = ThisWorkbook.Sheets("sheet1")
Set shtnew = ThisWorkbook.Sheets("sheet2")
Set shtmatch = ThisWorkbook.Sheets("sheet3")

Application.ScreenUpdating = False

     For oldrow = 2 To 10

    id = Trim(shtold.Cells(oldrow, 5))

    Set f = shtnew.Range("E2:E5").Find(id)

    If f Is Nothing Then

    With shtmatch.Rows(I)
        .Cells(1).Value = shtold.Cells(oldrow, 1)
        .Cells(2).Value = id
        .Cells(3).Value = shtold.Cells(oldrow, 2)


    End With

    I = I + 1
    End If
  Next oldrow

Application.ScreenUpdating = True
MsgBox "Finished", vbInformation, "Done!"

  End Sub>

输入

Sheet 1中

EmpName        EmpID       Role3
Aakash C Shah   id1       id1auditoruser
Abdul Yasin     id2       id2group adminpassword adminpassword admin
Abhijit Chakre  id3       id3group adminpassword admin
Abhijit Dixit   id4       id4dc admingroup admin

Sheet 2中

EmpName         EmpID   role3
Aakash C Shah   id1     id1auditordc adminpassword admin
Abdul Yasin     id2     id2group adminpassword adminpassword admin
Abhijit Chakre  id3     id3group adminpassword admin
Abhijit Dixit   id5     id5dc admingroup admin

输出（预期） -

EmpName           EmpID       Role3
 Aakash C Shah    id1         id1auditoruser

因为它与sheet2不同

Answer 1

这是一个UDF，它将根据以逗号分隔的字符串的输入返回已排序的字符串。如上所述，它不区分大小写，因此为了进行比较，结果将转换为所有小写字母。

要对这些短列表进行排序，可能会使用任何排序例程;我选择了一个Quicksort，因为它在我的库中很方便。

该代码演示了数组的拆分，排序和连接，因此它可以回答您的问题1,2和3.

Option Explicit
Option Compare Text 'case insensitive
Function sortCSS(str As String) As String
    Dim sArr() As String
    Dim I As Long

sArr = Split(str, ",")

'Remove the spaces
For I = 0 To UBound(sArr)
    sArr(I) = Trim(sArr(I))
Next I

Quick_Sort sArr, 0, UBound(sArr)

sortCSS = LCase(Join(sArr, ","))

End Function

Sub Quick_Sort(ByRef SortArray As Variant, ByVal first As Long, ByVal last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = first
High = last
List_Separator = SortArray((first + last) / 2)
Do
    Do While (SortArray(Low) < List_Separator)
        Low = Low + 1
    Loop
    Do While (SortArray(High) > List_Separator)
        High = High - 1
    Loop
    If (Low <= High) Then
        Temp = SortArray(Low)
        SortArray(Low) = SortArray(High)
        SortArray(High) = Temp
        Low = Low + 1
        High = High - 1
    End If
Loop While (Low <= High)
If (first < High) Then Quick_Sort SortArray, first, High
If (Low < last) Then Quick_Sort SortArray, Low, last
End Sub

以下是给出表格的输出：

但是，我会设置使用词典和类来完成此操作，但这只是我和个人偏好。

Answer 2

似乎至少你有各种各样的分隔符来分隔你的价值观，不正确/不一致的大写，一个雇员中的角色重复，表格和未分类数据之间的不匹配角色。

在子程序之前：

子程序：

Option Explicit

Sub repairRoles()
    Dim vTBLs As Variant, vVAL1 As Variant, vVAL2 As Variant

    vTBLs = Array("Table1", "Table2")

    With Worksheets("sheet4")
        vVAL1 = .ListObjects(vTBLs(0)).DataBodyRange.Columns(3).Value2
        vVAL2 = .ListObjects(vTBLs(1)).DataBodyRange.Columns(3).Value2
        sort_Correct_Homogenize_Dedupe vVAL1, vVAL2
        .ListObjects(vTBLs(0)).DataBodyRange.Columns(3) = vVAL1
        .ListObjects(vTBLs(1)).DataBodyRange.Columns(3) = vVAL2
    End With
End Sub

Sub sort_Correct_Homogenize_Dedupe(ByRef val1 As Variant, ByRef val2 As Variant, Optional delim As String = ", ")
    Dim v As Long, j As Long, k As Long, tmp As Variant, discard As Variant

    For v = LBound(val1, 1) To UBound(val1, 1)
        val1(v, 1) = Replace(val1(v, 1), Chr(44), Chr(44) & Chr(32)) & Chr(44) & Chr(32) & _
                     Replace(val2(v, 1), Chr(44), Chr(44) & Chr(32))
        val1(v, 1) = Application.Trim(val1(v, 1))
        tmp = Split(val1(v, 1), Chr(44) & Chr(32))
        For j = LBound(tmp) To UBound(tmp) - 1
            For k = j + 1 To UBound(tmp)
                If Mid(tmp(j), 2, 1) = LCase(Mid(tmp(j), 2, 1)) Then tmp(j) = StrConv(tmp(j), vbProperCase)
                If Mid(tmp(k), 2, 1) = LCase(Mid(tmp(k), 2, 1)) Then tmp(k) = StrConv(tmp(k), vbProperCase)
                If tmp(k) < tmp(j) And tmp(k) <> vbNullString Or tmp(j) = vbNullString Then
                    discard = tmp(j)
                    tmp(j) = tmp(k)
                    tmp(k) = discard
                ElseIf tmp(k) = tmp(j) Then
                    tmp(k) = vbNullString
                End If
            Next k
        Next j
        Do While tmp(UBound(tmp)) = vbNullString: ReDim Preserve tmp(UBound(tmp) - 1): Loop
        val1(v, 1) = Join(tmp, delim)
        val2(v, 1) = Join(tmp, delim)
    Next v
End Sub

在子程序之后：

我愿意在评论中回答具体问题，但你应该先做自己的研究。

字符串比较，如a，b，c，c，b，a

2 个答案: