Quite tricky. Please try this code after adjusting the items marked "change to suit".
Sub SetSequence()
' 156
Const DataClm As Long = 2 ' change to suit (2 = column B)
Const ItemClm As Long = 1 ' change to suit (1 = column A)
Dim Wb As Workbook
Dim Ws As Worksheet
Dim DataRng As Range ' sorted given data (column B in your example)
Dim Results As Variant ' results: sorted 1 to 5
Dim TmpClm As Long ' a column temporarily used by this macro
Dim Tmp As String ' working string
Dim R As Long ' oop counter: rows
Dim i As Long ' index of Results
Results = Array("Item1", "Item2", "Item3", _
"Item4", "Item5") ' modify list items as required (sorted!)
Set Wb = ThisWorkbook ' modify as needed
Set Ws = Wb.Worksheets("Sheet1") ' change to suit
With Ws
With .UsedRange
TmpClm = .Column + .Columns.Count
End With
' create a copy of your data (without header) in an unused column
.Range(.Cells(2, DataClm), .Cells(.Rows.Count, DataClm).End(xlUp)) _
.Copy .Cells(1, TmpClm)
Set DataRng = .Range(.Cells(1, TmpClm), .Cells(.Rows.Count, TmpClm).End(xlUp))
With .Sort.SortFields
.Clear
.Add2 Key:=Ws.Cells(1, TmpClm), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
End With
With .Sort
.SetRange DataRng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' blanks are removed, if any
Set DataRng = .Range(.Cells(1, TmpClm), .Cells(.Rows.Count, TmpClm).End(xlUp))
' start in row 2 of DataClm and look at next 5 cells
For R = 2 To 6
' skip over blanks
Tmp = .Cells(R, DataClm).Value
If Len(Trim(Tmp)) Then
i = WorksheetFunction.Match(Tmp, DataRng, 0)
.Cells(R, ItemClm).Value = Results(i - 1)
End If
Next R
.Columns(TmpClm).ClearContents
End With
End Sub
The code creates a sorted copy of the items you have in column B and draws the output in column A from the similarly sorted list of results. Blanks are ignored. But if there is one blank in the input list (column B) there will be only 4 items in the sorted input list and therefore none of the items can be assigned "Item 5" in column A.
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…