Как запустить функцию «FirstNumeric» только один раз? - PullRequest
0 голосов
/ 13 июня 2018

В настоящее время я пишу программу в Excel, использующую VBA, которая принимает номера контракта (буквенно-цифровую строку), состоящую из трех частей:

Office - два или три буквенных символа в начале строки (верхний или верхнийНижний регистр)

Пример: "abc"

Основа - четыре или пять чисел в середине строки

Пример: "12345"

Сравнительный -Один альфа-символ в конце строки (это будет не у всех строк)

Пример: "E"

Пример номера контракта: "abc12345E

У меня естьстолбец этих номеров контрактов в столбце E в электронной таблице, и я написал код для разделения части «Office» в столбце F, «базы» в столбце G и «сравнительной» в столбце H.

Myпроблема в том, что у меня есть функция с именем «FirstNumeric», которая используется, чтобы найти, где в строке начинаются мои числовые символы, чтобы ее можно было разделить в этих точках. Но я хочу вызвать эту функцию только один раз. В моем коде я вызываю ееTwiсе.Как я могу написать этот код, чтобы функция вызывалась только один раз?

 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

1 Ответ

0 голосов
/ 13 июня 2018

Удерживайте его в переменной, которую вы загружаете один раз, но ссылаетесь на нее дважды.- Вот так:

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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...