Question

删除每个单元格字符的最快方法是什么？我有300k行，每个单元循环都不理想。我尝试了文本到列，但我需要知道每个单元格中可能有多少个符号。有更好的方法吗？

这就是我循环300,000个小区的内容。这花费了太多时间。

For Each destineCell In destinRange
    cellVal = destineCell.Value
    If (InStr(cellVal, ", ")) Then
        removed = Left(cellVal, InStr(cellVal, ", ") - 1)
        ActiveCell.Value = removed & " "
    End If
    ActiveCell.Offset(1, 0).Select
Next destineCell

[[更新]] 这是示例数据的样子。

New York, NY, USA
Rome, Italy - Tier 1 City

数据本身各不相同。有时它会有逗号，短划线或两者。

Answer 1

删除每个单元格字符的最快方法是什么？我有300k行，每个单元循环都不理想。我尝试了文本到列，但我需要知道每个单元格中可能有多少个符号。有更好的方法吗？

@pnuts基本上删除逗号后的所有内容或 - - JamAndJammies 42分钟前

@pnuts之后的第一个逗号/破折号 - JamAndJammies 37分钟前

根据您的问题以及您在评论中所说的内容，最简单，最快捷的不使用VBA的方式是

设置您认为不会在数据中的单个字母分隔符。我们说它是|。或者你可以选择其他一些特殊的角色？我们称之为关键字。
按 Ctrl + H 打开查找和替换对话框并进行替换。找到,并将其替换为关键字。同样，使用关键字替换-。
执行Text To columns并将其拆分为关键字。
保留第1列并删除其余列

Answer 2

您可以将范围复制到Array，迭代数组替换值，然后将数组粘贴回来。因此，您将限制Excel recalc调用 - 它应该在300k上快几年，甚至比Range.Replace更快。这是一个例子：

Sub fastReplace()

    ' range to run the replace operation on
    Dim rngRepl As Range
    Set rngRepl = ActiveSheet.[a1:a4]

    ' read range into array (it is a 2D array)
    Dim arr()
    arr = rngRepl

    ' do the replace
    Dim i As Long
    Dim j As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            arr(i, j) = Replace(arr(i, j), "o", "a")
        Next j
    Next i

    ' paste array back
    rngRepl = arr

End Sub

Answer 3

这两种方法实际上花费了300,000个数据点的相似时间，在我的系统上大约0.5秒。

我确实更新了数组代码以处理所需的实际替换，更重要的是测试是否存在要替换的字符串（否则代码失败）。

我没有使用其他代码中的额外列，我可能会在使用此方法之前使用该表的副本，以便可以删除所有其他列而不会影响现有的其他数据。

代码到时间的方法

Sub Overall()
Dim dbTime As Double
Dim lngCalc As Long

With Application
 .ScreenUpdating = False
 lngCalc = .Calculation
 .EnableEvents = False
End With

dbTime = Timer()
Call fastReplace
Debug.Print Timer() - dbTime
dbTime = Timer()
Call SD
Debug.Print Timer() - dbTime

With Application
 .ScreenUpdating = True
 .Calculation = lngCalc
 .EnableEvents = True
End With

End Sub

整理数组

 Sub fastReplace()

    ' range to run the replace operation on
    Dim rngRepl As Range
    Dim arr()

    Set rngRepl = ActiveSheet.[a1:a300000]

    arr = rngRepl

    ' do the replace
    Dim i As Long
    Dim j As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            If InStr(arr(i, j), ", ") > 0 Then arr(i, j) = Left$(arr(i, j), InStr(arr(i, j), ", ") - 1)
        Next j
    Next i

    ' paste array back
    rngRepl.Value2 = arr

End Sub

文字到列

Sub SD()
 [a1:a300000].TextToColumns , , , , , , True
End Sub

Answer 4

或者在每个字符串上使用ObjectMapper objectMapper = new ObjectMapper(); objectMapper.configure(SerializationFeature.INDENT_OUTPUT, true); StringWriter stringWriter = new StringWriter(); objectMapper.writeValue(stringWriter, groupsList ); System.out.println("groupsList JSON is\n"+stringWrite);等效的单行VBA：

LEFT

Answer 5

修改

尝试此操作并相应地更改范围：

Option Explicit Sub FindAndReplace() Dim Arr() As Variant Arr = Range("A1:A3") Dim x As Integer For x = LBound(Arr) To UBound(Arr) Arr(x, 1) = Left(Arr(x, 1), InStr(Arr(x, 1), ",") - 1) Next x Range("A1").Resize(UBound(Arr), 1) = Arr End Sub

从单元格中删除字符的最快方法

5 个答案: