情况并不总是每个单元格中的值(ID)数量相同(至少1,max =几个),这就是为什么使用串联vlookup + left / mid / right的固定版本对我不起作用的原因因此,解决方案最多只能使用3个值。唯一固定的大小是要查找的值的大小(ID-绿色),8个字符(字母+数字)。
我不确定,但是可以在excel公式/函数中设置循环吗?下表是包含我要解决的问题和期望值的示例(表在不同的选项卡中)。希望能对您有所帮助。谢谢。
这里是一个UDF,它将执行您描述的操作。将代码粘贴到标准代码模块中(不是工作簿中已经存在的代码模块,而是您创建的代码模块,在将其更改为最喜欢的名称之前,其名称将类似于Module1
。也可以重命名该函数以提供它一个更合适的名称。
Function ID_v2(Cell As Range) As String
' 035
Dim Fun As String ' function return value
Dim Sp() As String ' array of CSVs of CellVal
Dim VLRng As Range ' the lookup range
Dim VL As Variant ' result of VLookup
Dim i As Integer ' loop counter
' this is a range similar to your sample A10:D19
Set VLRng = ThisWorkbook.Names("Table2").RefersToRange
Sp = Split(Cell.Cells(1).Value, ",")
If UBound(Sp) >= 0 Then
For i = 0 To UBound(Sp)
On Error Resume Next
VL = Application.VLookup(Trim(Sp(i)), VLRng, 3, False)
If Err Then VL = "[ERROR]"
Fun = Fun & VL & ","
Next i
ID_v2 = Left(Fun, Len(Fun) - 1) ' remove final comma
End If
End Function
使用内置函数之类的语法调用该函数。例如,
= ID_v2(A3)
可以像其他功能一样向下复制。但是请记住将工作簿另存为启用宏的功能。
尝试一下:
Option Explicit
Sub Cell2List()
Dim wF As WorksheetFunction: Set wF = Application.WorksheetFunction 'To user Transpose
Dim i As Range
Dim j As Range
Dim s As String: s = "," 'The separator of the list
'Ask the user for the cell where are the list with the commas
'Just need to select the cell
Set i = Application.InputBox("Select just one cell where the values are", "01. Selecte the values", , , , , , 8)
'Ask the for the separator. If you are completely sure the comma will never change just delete this line
s = Application.InputBox("Tell me, what is the character separator, just one character! (optional)", "02. Separator (comma semicolon colon or any other char)", , , , , , 2)
If s = "" Then s = "," 'Verifying...........
'Ask the user where want to put the list
'You need to get ready the cells to receive the list.
'If there any data will be lost, the macro will overwrite anything in the cells
Set j = Application.InputBox("Select just one cell where the values will go as a list, just one cell!", "03. Selecte the cell", , , , , , 8)
Dim myArr: myArr = (Split(i.Value, s)) 'Split the list into a Array
Range(Cells(j.Row, j.Column), Cells(j.Row + UBound(myArr), j.Column)).Value = wF.Transpose(myArr)
'j.Row is the row of the cell the user selected to put the cell
'j.Column the same, but the column
'j.Row + UBound(myArr) = UBound(myArr) is the total count of elements in the list
' +j.Row
' _______________
' the last cell of the new list!
'wF.Transpose(myArr) = we need to "flip" the array... Don't worry, but Don't change it!
End Sub
您可以将这个宏用一个按钮放在功能区的后面,或者使用它,就像在gif中看到的那样
这将是结果:(具有更大的列表)