Здравствуйте, не подскажете как создать макрос для замены всевозможных символов (включая пробелы), кроме латинских букв и цифр, на дефис?
И еще нужно заменить два или несколько дефисов подряд на один (т.е. если текст при замене на дефисы станет таким - "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 |
Заранее все спасибо за помощь!
) и все, не тратя время на прокрутку листа в пустую 