依赖于某个范围内另一个动态单元格的单元格的值



范围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末尾的数字来知道要放置哪个值。如果该行为空,它将跳过它。

最新更新