我是excel VB的新手,在以下问题中寻求助手:
我有一列 A 列,下面有以下值:
column A
"VL50s"
"M50s"
"H50s"
"VL50s"
"H50s"
我想提取数字并将下面的算术函数运行到列 B 中。
key:
x is a number
VLx --> (x) + 1
Mx -->(x) + 2
Hx --> (x) + 3
使用上面的键,输出应如下所示:
coloumn B
51
52
53
51
53
我想问一下我将如何在 VBA 中执行此功能。 感谢您的协助。
因为您说字母/数字组合的数量比您的示例中大得多,所以我认为这是 VBA 的问题,而不是工作表函数。WS功能将变得难以维护,并且很快就会变得野兽般的。
我做了这 4 个功能。GetCharArray
函数解析您传递给它的字符串的文本,以将该文本作为字符数组返回(即使 BA 没有char
类型,只有string
类型,所以我返回一个字符串。同样的想法)
然后,鉴于我们可以调用GetNumberFromChars
从VL50s
获取50
,并调用GetLeftMostLetters
以获取VL50s
VL
。
然后是一些工作表,我做了一个名为keys
的命名范围,其中范围的第 1 列是"VL"、"H"、"M"等字母......与之关联的相应值在第 2 列中。它看起来像
Col1 Col2
VL 1
M 2
H 3
... ...
我们可以将vlookup
工作表函数与Range("keys")
和GetLeftMostLetters
的结果一起使用,以查找应添加到GetNumberFromChars
结果中的数字。
Function GetNewNumber(inString As String) As Double
Dim searchString As String, numberToAddFromKeys As Double, numberToAddToFromCell As Long, cellChars() As String
cellChars = GetCharArray(inString)
searchString = GetLeftMostLetters(cellChars)
numberToAddToFromCell = GetNumberFromChars(cellChars)
'use the keys named range where column 1 is your letters ("VL","H"...)
'and column 2 is the corresponding value for that letter set
numberToAddFromKeys = WorksheetFunction.VLookup(searchString, Range("keys"), 2, 0)
GetNewNumber = CDbl(numberToAddFromKeys) + CDbl(numberToAddToFromCell)
End Function
Function GetNumberFromChars(inChars() As String) As Long
Dim returnNumber As String, i As Long, numberStarted As Boolean
For i = 1 To UBound(inChars)
If IsNumeric(inChars(i)) Then
If Not numberStarted Then numberStarted = True
returnNumber = returnNumber & inChars(i)
Else
If numberStarted Then
'this will ignore that "s" on the end of your sample data
'hopefully that's what you need
GetNumberFromChars = returnNumber
Exit Function
End If
End If
Next
End Function
Function GetLeftMostLetters(inChars() As String) As String
Dim returnString As String, i As Long
For i = 1 To UBound(inChars)
If Not IsNumeric(inChars(i)) Then
returnString = returnString & inChars(i)
Else
GetLeftMostLetters = returnString
End If
Next
End Function
Function GetCharArray(inText As String) As String()
Dim s() As String, i As Long
ReDim s(1 To Len(inText))
For i = 1 To UBound(s)
s(i) = Mid$(inText, i, 1)
Next
GetCharArray = s
End Function
所以它可以这样使用...
Dim cell As Range, rng As Range
'set this range to your actual range.
Set rng = Sheets("your sheet name").Range("A1:A5")
For Each cell In rng
'put this resulting value wherever you want.
Debug.Print GetNewNumber(cell.Value)
Next cell
您甚至不必为此使用 VBA,您可以使用(非常丑陋的)公式来确定这一点:
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1, "VL",""), "M",""), "H", ""),
"s", "") + IF(LEFT(A1, 2) = "VL", 1, IF(LEFT(A1, 1) = "M", 2,
IF(LEFT(A1,1) = "H", 3, 0)))
实际上,这个公式应该在一行上,但我在这里分解了它,以便它可读。 将公式放在单元格 B1 中,然后将其复制到您需要的任何其他单元格。 它去除"VL"、"M"、"H"和"s"的所有实例,然后根据 A 单元格的左 1 或 2 个字符添加额外的数字。
这将返回在输入值中找到的第一个数字:
Function GetNumber(val)
Dim re As Object
Dim allMatches
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "(d+)"
re.ignorecase = True
re.Global = True
Set allMatches = re.Execute(val)
If allMatches.Count > 0 Then
GetNumber = allMatches(0)
Else
GetNumber = ""
End If
End Function
编辑:刚刚注意到您的问题标题显示"十进制"数字 - 您的值是否有任何小数位,或者所有整数?