Блог

Я использую функцию FIND и REPLACE для поиска точек в диапазоне выбранных ячеек в number и замены их ничем.

Я хочу реализовать код для поиска более одной точки и замены их, выполнив эту процедуру только один раз. Например:

Выбор: 1.169. 499,08 —> желаемый результат: 1169499,08

Выбор: 111.222,08 —> желаемый результат: 111222,08

То, что я пробовал в качестве кода, это:

 Sub DEtoFR()
'defining the variable z which stores the German number formatting
'defining the variable x which stories the French number formatting

Dim z as Range, x as Variant
Set z = Selection.SpecialCells(xlCellTypeConstants,xlCellTypeConstants)

'Find Counts the Location of the "." character.
'Replace will look for it and replace "." with "". 

For Each x in z
    x.Value = Application.WorksheetFunction.Replace(x.Value, Application.WorksheetFunction.Find(".", x.value), 1, "")
Next x

End Sub
  

Вот еще один способ сделать что-то, может быть, вы подберете что-то полезное:

Перед:

Код:

 Sub Test()

Dim RNG As Range, LR As Double
With ActiveWorkbook.Sheets(1)
    LR = .Cells(Rows.Count, 1).End(xlUp).Row
    Set RNG = .Range(Cells(1, 1), Cells(LR, 1)).SpecialCells(2)
    RNG.Replace What:=".", Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
End With

End Sub
  

Результат:

Вы могли бы использовать Find и FindNext для этого вместо цикла

 Sub demo()
    Dim z As Range, c As Range
    ' Declare you range
    Set z = Sheet1.Range("A1:A10")

    With z
        Set c = .Find(".")

        If Not c Is Nothing Then
            Do
                c.Replace what:=".", replacement:=vbNullString
                Set c = .FindNext(c)
            Loop Until c Is Nothing
        End If
    End With
End Sub
  

Обновление после комментариев об эффективности
Я сгенерировал 1000 случайных чисел с десятичными дробями, используя:

 Sub CreateDecimals()
    Dim c As Range
    For Each c In Sheet1.Range("A1:A1000")
        c.Value2 = WorksheetFunction.RandBetween(0, 500000) / 100
    Next c
End Sub
  

Затем настройте два теста. Первый названный FindNextReplace (мой метод) и второй RangeReplace метод @JvdV.

 Public Sub FindNextReplace()
    Dim c As Range
    With Sheet1.Range("A1:A1000")
        Set c = .Find(".")

        If Not c Is Nothing Then
            Do
                c.Replace what:=".", replacement:=vbNullString
                Set c = .FindNext(c)
            Loop Until c Is Nothing
        End If
    End With
End Sub
  

 Public Sub RangeReplace()
    With Sheet1.Range("A1:A1000")
        .Replace what:=".", replacement:=vbNullString, searchorder:=xlByColumns, MatchCase:=True
    End With
End Sub
  

Затем я добавил функцию таймера, из которой я мог вызывать оба

 Sub TimerTest()
    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer
    Call RangeReplace

    SecondsElapsed = Round(Timer - StartTime, 2)

    Debug.Print "RangeReplace took:", SecondsElapsed
End Sub
  

Я сгенерировал случайные числа, используя CreateDecimals затем сделал их копию, чтобы я мог использовать одни и те же значения для обоих тестов. Я запустил один, заменил имена вложенных файлов в TimerTest подразделе и заменил исходные значения перед Replace и запустил его снова.

Результаты:

Как вы можете видеть, метод @JvdV явно более эффективен