Здравствуйте, не подскажете как создать макрос для замены всевозможных символов (включая пробелы), кроме латинских букв и цифр, на дефис?
И еще нужно заменить два или несколько дефисов подряд на один (т.е. если текст при замене на дефисы станет таким - "planeta--excel---xlsm", то заменить его на "planeta-excel-xlsm"
В этом деле я вообще не бум-бум (
Нашла макрос, который удаляет все символы кроме нужных, но оказалось не совсем то.... Лучше заменять. (так как в кодах VBA не разбираюсь, не получилось изменить готовый макрос)
Макрос такой:
Заранее все спасибо за помощь!
И еще нужно заменить два или несколько дефисов подряд на один (т.е. если текст при замене на дефисы станет таким - "planeta--excel---xlsm", то заменить его на "planeta-excel-xlsm"
В этом деле я вообще не бум-бум (
Нашла макрос, который удаляет все символы кроме нужных, но оказалось не совсем то.... Лучше заменять. (так как в кодах VBA не разбираюсь, не получилось изменить готовый макрос)
Макрос такой:
Код |
---|
Sub RemoveDigits() Dim vRange As Range, vCell As Range Dim vStr As Integer, rangeLastCol As Integer, rangeLastRow As Integer, tempLastRow As Integer, i As Integer Dim str_all As String, x As String, y As String, v As String, w As String rangeLastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To rangeLastCol tempLastRow = Cells(Rows.Count, i).End(xlUp).Row If rangeLastRow < tempLastRow Then rangeLastRow = tempLastRow End If Next i Set vRange = ThisWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(rangeLastRow, rangeLastCol)) str_all = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-" For Each vCell In vRange For vStr = 1 To Len(vCell) x = vCell.Value y = Mid(x, vStr, 1) If InStr(1, str_all, y) > 0 Then v = y y = "" Else v = "" y = "" End If w = w & v Next vStr vCell.Value = w x = "" y = "" v = "" w = "" Next vCell End Sub |