Доброе время суток.
Код |
---|
Public Sub RemoveDigits() Static pReg As Object Dim Cell As Range If TypeOf Selection Is Range Then If pReg Is Nothing Then Set pReg = CreateObject("VBScript.RegExp") pReg.Global = True: pReg.Pattern = "d" End If For Each Cell In Selection If Application.WorksheetFunction.IsText(Cell.Value) Then Cell.Value = pReg.Replace(Cell.Value, "") Next End If End Sub |
Макрос удаляет цифры и оставляет только текст в выделенных ячейках. Как переписать макрос, чтобы наоборот делалось, удалило текст оставив только цифры в выделенных ячейках?
оставить только цифры |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
Как оставить в ячейке только цифры или только текст?
Вот бывает так: есть у Вас в ячейке некий текст. Допустим «Было доставлено кусков мыла 763шт.». Вам нужно из этого только 763 — чтобы можно было провести с этим некие математические действия. Если это только одна ячейка — проблем тут нет, а если таких ячеек пару тысяч? И к тому же все разные?
- Было доставлено кусков мыла 763шт.
- Всего пришло 34
- Тюбики — 54 доставлено
- и т.д.
Никакой зацепки для извлечения данных. Пару тысяч таких строк удалять вручную весьма утомительное занятие, надо сказать. Да еще и не быстрое.
Есть несколько вариантов решения подобной задачи.
СПОСОБ 1: не используем макросы
можно применить формулу массива, вроде такой:
=ПСТР(A1;МИН(ЕСЛИ(ЕЧИСЛО(-ПСТР(A1;СТРОКА($1:$99);1));СТРОКА($1:$99)));ПРОСМОТР(2;1/ЕЧИСЛО(-ПСТР(A1;СТРОКА($1:$99);1));СТРОКА($1:$99))-МИН(ЕСЛИ(ЕЧИСЛО(-ПСТР(A1;СТРОКА($1:$99);1));СТРОКА($1:$99)))+1)
Три важных момента:
- Формула вводится в ячейку сочетанием клавиш Ctrl+Shift+Enter, т.к. является формулой массива. Подробнее про эти формулы читайте в статье: Что такое формула массива
- в таком виде формула работает с текстом, количество символов в котором не превышает 99. Чтобы расширить необходимо в формуле во всех местах заменить СТРОКА($1:$99) на СТРОКА($1:$200). Т.е. вместо 99 указать количество символов с запасом. Только не увлекайтесь, иначе может получиться, что формула будет работать слишком долго
- формула не обработает корректно текст «Было доставлено кусков мыла 763шт., а заказывали 780» и ему подобный, где числа раскиданы по тексту.
Теперь коротко разберем формулу на примере фразы: Было доставлено кусков мыла 763шт.
- в A1 сам текст, из которого необходимо извлечь числа: Было доставлено кусков мыла 763шт., а заказывали 780
- блок: МИН(ЕСЛИ(ЕЧИСЛО(-ПСТР(A1;СТРОКА($1:$99);1));СТРОКА($1:$99)))
вычисляет позицию первой цифры в ячейке — 29 - блок: ПРОСМОТР(2;1/ЕЧИСЛО(-ПСТР(A1;СТРОКА($1:$99);1));СТРОКА($1:$99))
вычисляет позицию последней цифры в ячейке — 31 - в результате получается: =ПСТР(A1;29;31—29+1)
функция ПСТР извлекает из текста, указанного первым аргументом(A1) текст, начиная с указанной позиции(29) с количеством символов, указанным третьим аргументом(31—29+1) - И в итоге:
=ПСТР(A1;29;31—29+1)
=> =ПСТР(A1;29;2+1)
=> =ПСТР(A1;29;3)
=> 763
СПОСОБ 2: используем макросы
Самый главный недостаток метода при помощи формулы, приведенной выше — из текста «Было доставлено кусков мыла 763шт., а заказывали 780» формула вернет не только числа, а и текст между первой и последней цифрой: 763шт., а заказывали 780.
Решить же проблему извлечения цифр даже из такого текста при помощи VBA куда проще и гибче. Плюс можно не только цифры извлекать, но и наоборот — цифры удалить, а извлечь только текст. Ниже приведен код пользовательской функции, которая поможет извлечь из строки только числа либо только текст. Иными словами, результатом функции будет либо только текст, либо только числа.
Function Extract_Number_from_Text(sWord As String, Optional Metod As Integer) ‘sWord = ссылка на ячейку или непосредственно текст ‘Metod = 0 – числа ‘Metod = 1 – текст Dim sSymbol As String, sInsertWord As String Dim i As Integer If sWord = «» Then Extract_Number_from_Text = «Нет данных!»: Exit Function sInsertWord = «» sSymbol = «» For i = 1 To Len(sWord) sSymbol = Mid(sWord, i, 1) If Metod = 1 Then If Not LCase(sSymbol) Like «*[0-9]*» Then If (sSymbol = «,» Or sSymbol = «.» Or sSymbol = » «) And i > 1 Then If Mid(sWord, i — 1, 1) Like «*[0-9]*» And Mid(sWord, i + 1, 1) Like «*[0-9]*» Then sSymbol = «» End If End If sInsertWord = sInsertWord & sSymbol End If Else If LCase(sSymbol) Like «*[0-9.,;:-]*» Then If LCase(sSymbol) Like «*[.,]*» And i > 1 Then If Not Mid(sWord, i — 1, 1) Like «*[0-9]*» Or Not Mid(sWord, i + 1, 1) Like «*[0-9]*» Then sSymbol = «» End If End If sInsertWord = sInsertWord & sSymbol End If End If Next i Extract_Number_from_Text = sInsertWord End Function
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
Function Extract_Number_from_Text(sWord As String, Optional Metod As Integer) ‘sWord = ссылка на ячейку или непосредственно текст ‘Metod = 0 – числа ‘Metod = 1 – текст Dim sSymbol As String, sInsertWord As String Dim i As Integer If sWord = «» Then Extract_Number_from_Text = «Нет данных!»: Exit Function sInsertWord = «» sSymbol = «» For i = 1 To Len(sWord) sSymbol = Mid(sWord, i, 1) If Metod = 1 Then If Not LCase(sSymbol) Like «*[0-9]*» Then If (sSymbol = «,» Or sSymbol = «.» Or sSymbol = » «) And i > 1 Then If Mid(sWord, i — 1, 1) Like «*[0-9]*» And Mid(sWord, i + 1, 1) Like «*[0-9]*» Then sSymbol = «» End If End If sInsertWord = sInsertWord & sSymbol End If Else If LCase(sSymbol) Like «*[0-9.,;:-]*» Then If LCase(sSymbol) Like «*[.,]*» And i > 1 Then If Not Mid(sWord, i — 1, 1) Like «*[0-9]*» Or Not Mid(sWord, i + 1, 1) Like «*[0-9]*» Then sSymbol = «» End If End If sInsertWord = sInsertWord & sSymbol End If End If Next i Extract_Number_from_Text = sInsertWord End Function |
Данный код необходимо поместить в стандартный модуль книги. После этого в мастере функций в категории Определенные пользователем (User Defined) будет доступна функция Extract_Number_from_Text, которую можно будет применять как обычную функцию на листе.
Для извлечения только чисел
=Extract_Number_from_Text(A1; 0)
или
=Extract_Number_from_Text(A1)
Для извлечения только текста
=Extract_Number_from_Text(A1; 1)
Подробнее про создание пользовательских функции и их применении можно почитать в статье Что такое функция пользователя(UDF)?
Помимо функции пользователя решил выложить и вариант с использованием диалогового окна:
Выбрать ячейку или диапазон с текстом(Лист1!$A$2:$A$10) — здесь указывается диапазон с исходными значениями, из которого необходимо оставить только числа или только текст.
Выберите ячейку для вывода данных(Лист1!$A$2) — указывается одна ячейка, с которой начать вывод преобразованных значений. В качестве этой ячейки можно выбрать первую ячейку диапазона с текстом(исходного) если необходимо произвести изменения сразу в этих же ячейках(как на рисунке). Осторожнее с таким указанием, т.к. результат работы кода может быть не совсем таким, какой вы ожидали, а вернуть прежние данные уже не получится — если только не закрыть файл без сохранения изменений.
Оставить только цифры, Оставить только текст— думаю не надо пояснять. Здесь выбираем, что оставить в качестве результата.
Небольшое дополнение к использованию кода
В коде есть строка:
If LCase(sSymbol) Like «*[0-9.,;:-]*» Then
1 |
If LCase(sSymbol) Like «*[0-9.,;:-]*» Then |
Данная строка отвечает за текстовые символы, которые могут встречаться внутри чисел и которые надо оставить(не удалять наравне с другими не числовыми символами). Следовательно, если какие-то из данных символов не нужны в конечном тексте — их надо просто удалить. Например, чтобы оставались исключительно числа(без запятых и пр.):
If LCase(sSymbol) Like «*[0-9]*» Then
1 |
If LCase(sSymbol) Like «*[0-9]*» Then |
если надо исключить из удаления помимо цифр точку(т.е. будут извлечены цифры и точка):
If LCase(sSymbol) Like «*[0-9.]*» Then
1 |
If LCase(sSymbol) Like «*[0-9.]*» Then |
и т.д.
Скачать пример:
Tips_Macro_Number_From_Text.xls (80,0 KiB, 9 014 скачиваний)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
Sub Procedure_1() 'В константе "myColumnNumber" нужно указать 'номер обрабатываемого столбца. Const myColumnNumber As Long = 1 Dim myColumn() As Variant Dim myLastRow As Long Dim i As Long, j As Long '1. Ускоряем работу кода. Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual '2. Определяем последнюю строку с данными, чтобы 'знать, сколько строк обработать. myLastRow = Columns(myColumnNumber).Find(What:="?", LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _ MatchCase:=False, SearchFormat:=False).Row '3. Помещаем данные из столбца в VBA-массив. 'В VBA-массиве быстрее будет работать код. myColumn() = ActiveSheet.Range( _ ActiveSheet.Cells(1, myColumnNumber), _ ActiveSheet.Cells(myLastRow, myColumnNumber)).Value '4. В цикле с переменной "i" проходимся по всем элементам массива "myColumn". For i = 1 To UBound(myColumn, 1) Step 1 '5. Если пусто или содержатся только пробелы в элементе массива, 'то переходим к следующему элементу. If Trim(myColumn(i, 1)) = Empty Then GoTo metka End If '6. Если данные в элементе массива воспринимаются, как число, 'то удаляем только точку. If IsNumeric(myColumn(i, 1)) = True Then '6.1. Переводим тип данных в текст, т.к. предполагается 'с числом работать как с текстом. myColumn(i, 1) = CStr(myColumn(i, 1)) '6.2. Удаляем запятую. myColumn(i, 1) = Replace(myColumn(i, 1), ",", " ") '6.3. Удаляем пробелы. myColumn(i, 1) = Replace(myColumn(i, 1), " ", "") 'Переходим к следующему элементу. GoTo metka End If 'Если код дошёл сюда, значит перед нами данные в виде текста. 'В цикле с "j" просматриваем каждый символ в элементе массива. For j = 1 To Len(myColumn(i, 1)) Step 1 '7. Если символ не является цифрой, 'то символ заменяется пробелом. If Mid(myColumn(i, 1), j, 1) Like "[0-9]" = False Then 'Кажется быстрее заменять в строке символ, чем удалять. Mid(myColumn(i, 1), j, 1) = " " End If Next j '8. Удаляем пробелы. myColumn(i, 1) = Replace(myColumn(i, 1), " ", "") metka: Next i '9. Выводим VBA-массив в Excel. ActiveSheet.Range( _ ActiveSheet.Cells(1, myColumnNumber), _ ActiveSheet.Cells(myLastRow, myColumnNumber)).Value = myColumn() '10. Включаем то, что отключали. Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub |
Недавно мы рассмотрели как можно вернуть из строки только буквы, исключив цифры. Теперь же мы рассмотрим обратную ситуацию, когда из строки нам необходимо вернуть только цифры, исключив текстовую информацию.
Задача все та же — у нас есть столбец с данными (и текс и цифры) и нам требуется разбить отдельно текст и отдельно цифры. Как мы писали выше с текстом мы уже разобрались, осталось вытащить цифры.
Встроенной функции для этих целей в Excel так же нет, поэтому мы будем писать пользовательскую.
Public Function GetNumbers(TargetCell As Range) As String Dim LenStr As Long For LenStr = 1 To Len(TargetCell) Select Case Asc(Mid(TargetCell, LenStr, 1)) Case 48 To 57 GetNumbers = GetNumbers & Mid(TargetCell, LenStr, 1) End Select Next End Function
Как пользоваться?
Открываем редактор VBA в Excel (Alt+F11), или правой кнопкой по листу и выбираем пункт «Исходный текст».
Создаем новый модуль → Insert → Module
Переключаемся на российскую раскладку клавиатуры, копируем код, указанный выше и вставляем в модуль
Далее в нужной ячейке, где необходимо вывести только буквы, прописываем формулу:
=GetNumbers(A1)
и протягиваем ее вниз