-1

私はExcelVBを初めて使用し、以下の問題でアシスタントを探しています。

以下の値を持つ列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でこの機能を実行するにはどうすればよいですか。ご協力いただきありがとうございます。

4

3 に答える 3

1

文字と数字の組み合わせの数が例よりもはるかに多いと言っているので、これはVBAの問題であり、ワークシート関数ではないと思います。WS機能は、維持するのが難しくなり、非常に迅速になります。

これら4つの機能を作りました。このGetCharArray関数は、渡された文字列のテキストを解析して、そのテキストを文字の配列として返します（BAにはchar型だけのstring型がないため、文字列を返します。同じ考えです）

次に、fromを取得するために呼び出し、fromを取得するために呼び出すことができると仮定しGetNumberFromCharsます。50VL50sGetLeftMostLettersVLVL50s

次に、名前付き範囲を作成したワークシートがkeysあります。範囲の列1は「VL」、「H」、「M」などの文字で、それに関連付けられた対応する値は列2にあります。

Col1    Col2
VL      1
M       2
H       3
...     ...

との結果でvlookupワークシート関数を使用して、の結果に追加する必要のある数値を見つけることができます。Range("keys")GetLeftMostLettersGetNumberFromChars

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
于 2012-08-06T15:26:07.637 に答える
0

これにより、入力値で最初に見つかった数値が返されます。

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

編集：質問のタイトルに「小数点以下の桁数」と表示されていることに気づきました。値には小数点以下の桁数がありますか、それともすべて整数ですか。

于 2012-08-06T16:54:28.707 に答える
0

そのために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)))

実際には、この数式は1行になっているはずですが、読みやすいようにここで分割しました。数式をセルB1に配置し、必要な他のセルにコピーします。「VL」、「M」、「H」、「s」のすべてのインスタンスを取り除き、Aセルの左側の1文字または2文字に基づいて余分な番号を追加します。

于 2012-08-06T12:52:27.800 に答える