VBA in excel 在列之间移动值

Question

我有 excel 文件，其中填充了两列。第一，包括数字，第二个字母。我想用条件按字母填写第三列：如果相同的数字在第二列的任何单元格中具有 "A"，则在第三列中为该数字的每个单元格填充字母 A ELSEIF "B" THEN B 第三列... 优先级 A>B>C>D

Answer 1

如果您可以使用公式代替 VBA，则可以使用以下公式：

=IF(COUNTIFS(A:A,A2,B:B,"A")>0,"A",IF(COUNTIFS(A:A,A2,B:B,"B")>0,"B",IF(COUNTIFS(A:A,A2,B:B,"C")>0,"C","D")))

在这个公式中 COUNTIF 函数正在组合 2 个条件并计算是否满足这些条件，然后 IF 函数正在将相关字母输入单元格。

Answer 2

使用这个

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

输出结果

VBA in excel 在列之间移动值

VBA in excel move value between columns

excel

vba

loops

conditional-statements

已根据新要求进行更新