Выборка конкретного цифрового значения из текста

[tissot]

Здравствуйте, уважаемые знатоки !
Помогите, пожалуйста, в решении следующей задачи (файл во вложении).

Есть строчки, допустим порядка 300, каждая из которых имеет цифровое значение состоящее из 8 цифр. При этом эта цифра, всегда находится в тексте.

Задача состоит в том, чтобы все цифровые значения состоящие из 8-и цифр, находящиеся на одном листе можно было выделить (извлечь) и перенести в другой файл (лист) Excel.

В итоге, на листе останется только текст и остальные цифровые значения (не восьмизначные).

Есть ли какая-то формула, для поиска таких восьмизначных цифр и копирования этих значений ?

[motorway]

Если в качестве разделителей всегда используются запятые или точки с запятой, можно с помощью команды Split разбить строку на подстроки и сверять их длину с 8, а затем проверять, все ли в строке является цифрой

[tissot]

Честно говоря, я не совсем понял, что Вы имели ввиду, а может быть Вы не поняли. Нужно сделать так, чтобы по всему листу цифра (код) обязательно состоящая из 8-ми цифр, каким-то образом выделилась, (а таких восьмизначных цифр в тексте будет, например 300).
Так вот, необходимо найти именно эти цифры и их можно было все одновременно скопировать, таким образом произойдет автоматическое отсеивание от других элементов листа (текста и т.д.).
Допустим, при этом в файле вообще нет разделителей вроде , ; . и т.д. а просто сплошной текст и цифры в одной ячейке.

[motorway]

Я-то понял, но если разделителей нет, то такой случай как а12345678б не нужно учитывать? По-моему, разделители должны быть хотя бы в виде пробелов, отделяющих это число от других слов. То есть, вам нужно, чтобы число выделялось даже в том случае, если справа и слева непосредственно есть другие знаки (не пробел)?

[doober]

Во вложении пользовательская функция NOMER

[EducatedFool]

doober, спасибо за функцию (я до сих пор не разобрался с RegExp)

Немного переделал её для себя - чтобы можно было искать любое число цифр:

Function FindDigits(ByVal txt$, ByVal DigitsCount%) As String
    ' ищет в строке txt$ подстроку цифр длиной DigitsCount%
    Set expres = CreateObject("VBScript.RegExp")
    expres.Pattern = Replace(String(DigitsCount%, "%"), "%", "[0-9]")
    If expres.test(txt$) Then FindDigits = expres.Execute(txt$)(0).Value
End Function

(добавлено - после изучения RegExp по этой статье)
Как выяснилось, в плане алгоритма так будет правильнее:
(ищем блок именно из 8 цифр - блоки из 9 и более цифр не попадают в результат)

Function FindDigits(ByVal txt$, ByVal DigitsCount%) As String
    ' ищет в строке txt$ подстроку цифр длиной DigitsCount%
    Set RegExp = CreateObject("VBScript.RegExp"): RegExp.Global = True
    RegExp.Pattern = "[\D]": txt$ = " " & RegExp.Replace(txt$, " ") & " "
    RegExp.Pattern = " [\d]{" & DigitsCount% & "} "
    If RegExp.test(txt$) Then FindDigits = Trim$(RegExp.Execute(txt$)(0).Value)
End Function

Для вывода артикулов на отдельный лист используйте такой макрос:

Sub test()
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))
    shd.UsedRange.ClearContents ' очистка листа
    For Each cell In ra.Cells
        txt = FindDigits(cell.Text, 8)
        If Len(txt) Then shd.Range("A" & shd.Rows.Count).End(xlUp).Offset(1) = txt
    Next cell
    shd.Activate
End Sub

Пример в файле:

[SAS888]

doober, EducatedFool
+1 (каждому). Спасибо за полезную информацию.

[tissot]

Господа, Вы, конечно, профи. Огромное спасибо 5+.
Задача решена и этот результат, думаю, поможет многим любителям и экспертам.
P/s. Я не профи в макросах, но в контексте этого решения, небольшой вопрос. В какой строчке макроса необходимо внести изменение, чтобы проверка происходила в отношении десятизначной цифры.

[EducatedFool]

чтобы проверка происходила в отношении десятизначной цифры

А вы формулы в ячейках смотрели?

  Ячейка: B2      Формула  (стиль A1):   =FindDigits(A2;8)
                  Формула  (стиль R1C1): =FindDigits(RC[-1];8)

  Ячейка: C2      Формула  (стиль A1):   =FindDigits(A2;5)
                  Формула  (стиль R1C1): =FindDigits(RC[-2];5)

Вот эти цифры (которые я выделил красным) и замените на 10

В макросе - аналогично:

txt = FindDigits(cell.Text, 8)

[tissot]

Всё понял ! Всё работает ! Надеюсь, что многим помогут эти ценные советы.