时间戳

首页 > 解决方案 > 如何让函数“FirstNumeric”只运行一次？

excel - 如何让函数“FirstNumeric”只运行一次？

问题描述

我目前正在使用 VBA 在 Excel 中编写一个程序，该程序采用由三部分组成的合同编号（字母数字字符串）：

Office - 字符串开头的两个或三个字母字符（大写或小写）

示例：“abc”

基数 - 字符串中间的四个或五个数字

示例：“12345”

比较 - 字符串末尾的单个 Alpha 字符（并非所有字符串都有此字符）

示例：“E”

合同编号示例：“abc12345E

我在电子表格的 E 列中有这些合同编号的列，并且我编写了代码来分隔 F 列中的“办公室”部分、G 列中的“基础”部分和 H 列中的“比较”部分。

我的问题是我有一个名为“FirstNumeric”的函数，用于查找字符串中我的数字字符的开始位置，以便可以在这些点处将其分开。但我只想调用这个函数一次。在我的代码中，我调用了它两次。如何编写此代码以使该函数仅调用一次？

 Public Sub PharseContractNumber()
    Dim MyContract As String
    Dim MyIndex As Integer

    'Set Index to first process row
    MyIndex = 3

    'Get First Contract
    MyContract = UCase(Trim(Worksheets("Sheet1").Range("E" & MyIndex)))  'Tells which column the original strings are in, so they can be transformed

    'Stop if no contract
    Do Until MyContract = ""

            'Write Office
            Worksheets("Sheet1").Range("F" & MyIndex) = UCase(Mid(MyContract, 1, (FirstNumeric(MyContract) - 1)))

            'Remove Office
            MyContract = Mid(MyContract, (FirstNumeric(MyContract)))

            'Check for Trailing Alpha Character
            If Not (IsNumeric(Mid(MyContract, Len(MyContract)))) Then

                'Write Comparative
                Worksheets("Sheet1").Range("H" & MyIndex) = UCase(Mid(MyContract, (Len(MyContract))))

                'Remove Comparative
                MyContract = Mid(MyContract, 1, Len(MyContract) - 1)   'removes the Comparative portion of the original string in the Base Column

            End If

            'Write Remaining ... Base number
            Worksheets("Sheet1").Range("G" & MyIndex) = UCase(MyContract) 'writes in the base number

        'Advance Index
        MyIndex = MyIndex + 1

        'Get Next Contract
        MyContract = Trim(Worksheets("Sheet1").Range("E" & MyIndex))
    Loop

    End Sub

    Private Function FirstNumeric(PassContract) As Integer
    Dim i As Integer

    FirstNumeric = 0

    For i = 1 To Len(PassContract) + 1
        If IsNumeric(Mid(PassContract, i, 1)) Then
            FirstNumeric = i
            Exit For

        End If
    Next

    End Function

标签： excelvba

解决方案

将其保存在您加载一次但引用两次的变量中。- 像这样：

Dim FirNum As Integer

'Stop if no contract
Do Until MyContract = ""

        FirNum = FirstNumeric(MyContract)

        'Write Office
        Worksheets("Sheet1").Range("F" & MyIndex) = UCase(Mid(MyContract, 1, (FirNum - 1)))

        'Remove Office
        MyContract = Mid(MyContract, FirNum)

推荐阅读