Sub Repl() Dim Lr%, Lc%, Rn As Range Lr = Cells(Rows.Count, 1).End(xlUp).Row Lc = Cells(1, Columns.Count).End(xlToLeft).Column For Each Rn In Range(Cells(1, 1), Cells(Lr, Lc)) If Left(Rn, 1) = """" And Right(Rn, 1) = """" Then Rn = "«" & Mid(Rn, 2, Len(Rn) - 2) & "»" Next End Sub
[/vba] В макросе всего одна проверка - замена на угловые кавычки происходит, если в начале и в конце текста стоят обычные кавычки.
Для вашего примера можно так. [vba]
Код
Sub Repl() Dim Lr%, Lc%, Rn As Range Lr = Cells(Rows.Count, 1).End(xlUp).Row Lc = Cells(1, Columns.Count).End(xlToLeft).Column For Each Rn In Range(Cells(1, 1), Cells(Lr, Lc)) If Left(Rn, 1) = """" And Right(Rn, 1) = """" Then Rn = "«" & Mid(Rn, 2, Len(Rn) - 2) & "»" Next End Sub
[/vba] В макросе всего одна проверка - замена на угловые кавычки происходит, если в начале и в конце текста стоят обычные кавычки.i691198
И попутно формулы в значения переводит))) Такой вариант: [vba]
Код
Sub tt() On Error Resume Next Set d0_ = Range("A1").SpecialCells(xlCellTypeConstants, 2) If Err Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = 0 d0_.Replace What:="""", Replacement:="«" For Each d_ In d0_.Areas ar_ = d_.Value For i = 1 To UBound(ar_) For j = 1 To UBound(ar_, 2) t_ = ar_(i, j) n_ = Len(t_) - Len(Replace(t_, "«", "")) If n_ Then For k = n_ To 2 Step -2 t_ = WorksheetFunction.Substitute(t_, "«", "»", k) Next k ar_(i, j) = t_ End If Next j Next i d_.Value = ar_ Next d_ Application.ScreenUpdating = 1 End Sub
И попутно формулы в значения переводит))) Такой вариант: [vba]
Код
Sub tt() On Error Resume Next Set d0_ = Range("A1").SpecialCells(xlCellTypeConstants, 2) If Err Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = 0 d0_.Replace What:="""", Replacement:="«" For Each d_ In d0_.Areas ar_ = d_.Value For i = 1 To UBound(ar_) For j = 1 To UBound(ar_, 2) t_ = ar_(i, j) n_ = Len(t_) - Len(Replace(t_, "«", "")) If n_ Then For k = n_ To 2 Step -2 t_ = WorksheetFunction.Substitute(t_, "«", "»", k) Next k ar_(i, j) = t_ End If Next j Next i d_.Value = ar_ Next d_ Application.ScreenUpdating = 1 End Sub
Sub Repl_() Dim cell As Range With CreateObject("VBScript.RegExp") .Pattern = "^""(.+)""$" For Each cell In Range("A1:D13") If .test(cell) Then cell = "«" & .Execute(cell)(0).SubMatches(0) & "»" End If Next End With End Sub
[/vba]
[vba]
Код
Sub Repl_() Dim cell As Range With CreateObject("VBScript.RegExp") .Pattern = "^""(.+)""$" For Each cell In Range("A1:D13") If .test(cell) Then cell = "«" & .Execute(cell)(0).SubMatches(0) & "»" End If Next End With End Sub
Sub Repl_Kavychki() Dim cll As Range, rng_1 As Range, n As Long, m As Long Set rng_1 = ActiveSheet.UsedRange arr_1 = rng_1.Value Set objRegExp = CreateObject("VBScript.RegExp") With objRegExp .Pattern = """(.*?)""": .Global = True For n = 1 To UBound(arr_1) For m = 1 To UBound(arr_1, 2) Set objMatches = .Execute(arr_1(n, m)) With objMatches For i = 0 To .Count - 1 arr_1(n, m) = Left(arr_1(n, m), .Item(i).FirstIndex) & "«" & .Item(i).SubMatches(0) & "»" & _ Mid(arr_1(n, m), .Item(i).FirstIndex + .Item(i).Length + 1) Next End With Next Next End With rng_1.Value = arr_1 End Sub
[/vba]
Ещё вариант с regex [vba]
Код
Sub Repl_Kavychki() Dim cll As Range, rng_1 As Range, n As Long, m As Long Set rng_1 = ActiveSheet.UsedRange arr_1 = rng_1.Value Set objRegExp = CreateObject("VBScript.RegExp") With objRegExp .Pattern = """(.*?)""": .Global = True For n = 1 To UBound(arr_1) For m = 1 To UBound(arr_1, 2) Set objMatches = .Execute(arr_1(n, m)) With objMatches For i = 0 To .Count - 1 arr_1(n, m) = Left(arr_1(n, m), .Item(i).FirstIndex) & "«" & .Item(i).SubMatches(0) & "»" & _ Mid(arr_1(n, m), .Item(i).FirstIndex + .Item(i).Length + 1) Next End With Next Next End With rng_1.Value = arr_1 End Sub