需要使用VBA将2个范围之间的匹配添加到第三个范围

时间:2017-03-12 15:10:19

标签: excel vba excel-vba module

我需要代码搜索一个范围的一个工作表(Shell E20:P37)并将其与另一个工作表上的范围进行比较(Shift Alignment W4:W20),并将任何匹配放入新的范围(Shell W16) :W20)。

然后我需要它按字母顺序自动对新范围进行排序。

我希望它能够更新列表,因为在没有点击按钮的情况下自动在范围中输入新数据。

以下是我之前正在处理的代码,它现在无法正常工作。

Sub STARCalc()

Dim Cell As Range
Dim Cell2 As Range
Dim Names As Range
Dim STAR As Range
Dim Hours As Range
Dim Row As Integer
Dim Row2 As Integer
Dim CurSel As Range

Application.ScreenUpdating = True

Set CurSel = ActiveCell
Range("W16:W20").ClearContents

Set Names = ActiveSheet.Range("E20", "P37")
Set STAR = Worksheets("Shift Alignment").Range("M4", "M20")
Row = 16

For Each Cell In Names
For Each Cell2 In STAR
    If Cell.Value = Empty Then
    ElseIf Cell2.Value = Empty Then
    ElseIf Cell.Value = Cell2.Value Then
    Else ActiveSheet.Cells(Row, 20).Value = Cell2.Value
    End If
    Row = Row + 1

    Range("W16:W20").Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("W16") _
        , SortOn:=xlSortOnValues, Order:=xlAscending,   DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
       .SetRange Range("W16:W20")
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
    End With

    CurSel.Select

End Sub

0 个答案:

没有答案