我需要代码搜索一个范围的一个工作表(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