从单元格中删除字符的最快方法
什么是删除每个单元格字符的最快方法？ 我有30万行，循环每个单元格是不理想的。 我尝试的文本列，但我需要知道有多less个符号可以在每个单元格内。 有一个更好的方法吗？
这是我有循环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
数据本身不一样。 有时会有一个逗号，一个短划线或两个。
您可以将范围复制到Array ，遍历数组replace值，然后粘贴数组。 因此，您将限制Excel recalc调用 – 在300k上它应该比Range.Replace更快，甚至比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
什么是删除每个单元格字符的最快方法？ 我有30万行，循环每个单元格是不理想的。 我尝试的文本列，但我需要知道有多less个符号可以在每个单元格内。 有一个更好的方法吗？
@pnuts基本上在逗号或 – – JamAndJammies 42分钟前删除所有内容
在第一个逗号/破折号之后的@pnuts – JamAndJammies 37分钟前
根据你的问题和你在评论中所说的话，不会使用VBA的最简单和最快的方法是
- 设置您感觉不会在数据中的单个字母分隔符。 假设它是
|。 或者你可以select一些其他的特殊字符？ 我们来调用这个关键字 。 - 按下Ctrl + H打开查找和replace对话框并进行replace。 find并用关键字replace它。 同样replace
-关键字 。 - 做
Text To columns并将其分割在关键字上 。 - 保留第一列并删除其余列
两种方法实际上都需要相似的时间来处理300,000个数据点，在我的系统上大约需要0.5秒。
我没有更新数组代码来处理所需的实际replace，更重要的是testing要replace的string是否存在（否则代码失败）。
我没有使用其他代码中的额外列，我可能会在使用此方法之前使用该表的副本，以便可以删除所有其他列而不影响现有的其他数据。
代码到时间的方法
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
或者在每个string上使用LEFT的单行VBA等价物：
[a1:A300000] = Application.Evaluate("=IF(ISERR(FIND("","",A1:a300000)),A1:A300000,LEFT(A1:A300000,FIND("","",A1:A300000)-1))")
编辑
试试这个，并相应地改变你的范围：
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