Question

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

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

示例：＆＃34; abc＆＃34;

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

示例：＆＃34; 12345＆＃34;

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

示例：＆＃34; E＆＃34;

合同编号示例：＆＃34; abc12345E

我在电子表格的E栏中有一列这些合同号码，我已编写代码来分隔＆＃34; Office＆＃34; F列中的部分，＆＃34; Base＆＃34;在G栏和＆＃34;比较＆＃34;在H栏中。

我的问题是我有一个名为＆＃34; FirstNumeric＆＃34;用于查找字符串中我的数字字符开始的位置，以便在这些点处分开。但我只想调用一次这个函数。在我的代码中，我称之为两次。如何编写此代码以便仅调用该函数一次？

 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

Answer 1

将其保存在您加载一次的变量中，但请参阅两次。 - 像这样：

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)

如何使用Function＆＃34; FirstNumeric＆＃34;只运行一次？

1 个答案: