Question

我从互联网上获得了这个vba：

Sub MatchCompanyName_InsertContact_EmailAddress()
    Dim hold As New Collection

    For Each celli In Columns(6).Cells
        On Error GoTo raa
        If Not celli.Value = Empty Then
            hold.Add Item:=celli.Row, key:="" & celli.Value
        End If
    Next celli

    On Error Resume Next
    raa:
    Range("J1:L1").Offset(celli.Row - 1, 0).Value = Range("J1:L1").Offset(hold(celli.Value) - 1, 0).Value
    Resume Next
End Sub

代码查找＆amp;替换序列是从上到下排，我需要它反过来。

Answer 1

您需要撤消收藏中的项目。一种方法是添加一个新的集合并以相反的顺序传输：

raa:

Dim newHold as New Collection
For Each obj in hold
    If newHold.Count > 0 Then
        newHold.Add item := obj, before := 1
    Else
        newHold.Add item := obj
    End If
Next

Range("J1:L1").Offset(celli.Row - 1, 0).Value = Range("J1:L1").Offset(newHold(celli.Value) - 1, 0).Value

Excel Macro Find＆amp;将列的重复值从底行替换为顶行序列

1 个答案: