范围A1:A5填充了动态数据,尽管数据限制为5个值,但序列可能不同。也有可能仅呈现4个或更少。这些值也是唯一的。
列B的值将取决于列A。
示例:
A B
1 item2 USD18
2 item1 USD15
3 item3 USD4
4 item5 USD23
5 item4 USD11
如何在VBA上完成此操作?
相当棘手。请在调整标记为";换衣服";。
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
该代码创建B列中项目的排序副本,并从类似排序的结果列表中绘制a列中的输出。空白将被忽略。但是如果在输入列表(列B(中有一个空白,则在排序的输入列表中将只有4个项目;项目5";A栏。
我已经用下面的答案替换了我的答案,这完全改变了事情。
看看这是否是你想要的:
Dim ValueArr As Variant
ValueArr = Array("USD15", "USD18", "USD4", "USD11", "USD23")
For i = 1 To 5
If Range("A" & i) <> "" Then
Range("B" & i) = ValueArr(Right(Range("A" & i), 1) - 1)
End If
Next i
该代码基于使用item
末尾的数字来知道要放置哪个值。如果该行为空,它将跳过它。