Excel中的VBA在列之间移动值

debugcn 发表于 Dev

苹果电脑

我有填充两列的excel文件。首先，包括数字，第二个字母。我想用以下条件用字母填充第三列：如果相同的数字在第二列的任何单元格中都有“ A”，则在第三列中将该数字的每个单元格填充字母A，在第三列中ELSEIF“ B”然后在第三列中填充B。。优先级A> B> C> D

瓦西里·伊沃扎（Vasily Ivoyzha）

用这个

Sub test()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim Cl As Range, i&
    i = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For Each Cl In ActiveSheet.Range("A1:A" & i)
        If Not Dic.exists(Cl.Value & Cl.Offset(, 1).Value) Then
            Dic.Add (Cl.Value & Cl.Offset(, 1).Value), Cl.Row
        End If
    Next
    For Each Cl In ActiveSheet.Range("A1:A" & i)
        If Dic.exists(Cl.Value & "A") Then
            Cl.Offset(, 2).Value = "A"
        ElseIf Dic.exists(Cl.Value & "B") Then
            Cl.Offset(, 2).Value = "B"
        ElseIf Dic.exists(Cl.Value & "C") Then
            Cl.Offset(, 2).Value = "C"
        ElseIf Dic.exists(Cl.Value & "D") Then
            Cl.Offset(, 2).Value = "D"
        End If
    Next
End Sub

输出结果是

在此处输入图片说明

根据新要求进行了更新

用这个

Sub test()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim Cl As Range, i&, key As Variant
    i = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For Each Cl In ActiveSheet.Range("A1:A" & i)
        If Not Dic.exists(Cl.Value & Cl.Offset(, 1).Value) Then
            Dic.Add (Cl.Value & Cl.Offset(, 1).Value), Cl.Row
        End If
    Next
    For Each Cl In ActiveSheet.Range("A1:A" & i)
        For Each key In Dic
            If UCase(key) Like Cl.Value & "*A*" Then
                Cl.Offset(, 2).Value = Mid(key, 2, 100)
                Exit For
            End If
        Next
        If Cl.Offset(, 2).Value = Empty Then
            For Each key In Dic
                If UCase(key) Like Cl.Value & "*B*" Then
                    Cl.Offset(, 2).Value = Mid(key, 2, 100)
                    Exit For
                End If
            Next
        End If
        If Cl.Offset(, 2).Value = Empty Then
            For Each key In Dic
                If UCase(key) Like Cl.Value & "*C*" Then
                    Cl.Offset(, 2).Value = Mid(key, 2, 100)
                    Exit For
                End If
            Next
        End If
        If Cl.Offset(, 2).Value = Empty Then
            For Each key In Dic
                If UCase(key) Like Cl.Value & "*D*" Then
                    Cl.Offset(, 2).Value = Mid(key, 2, 100)
                    Exit For
                End If
            Next
        End If
    Next
End Sub

输出结果

在此处输入图片说明