代码重载内存或不会编译VBA

试图编写一个macros来根据string的长度在文本string中的特定点处插入连字符，或者在所述点之后删除所有文本。

即 – 如果是6个字符，则在char 4 + 5之间插入连字符或在char 4之后删除所有文本 – 如果是7个字符，则在char 5 + 6之间插入连字符或删除char 5之后的所有文本

理想情况下，我希望能够截断string在这一点，而不是连字符的文本，但我不能让我的脑袋周围如何使其工作，所以我决定连字符，然后运行一个查找和replace' – *'删除不需要的字符。 可以得到这个小样本集100-300单元的工作，但我需要的代码能够通过与70,000 +单元格的工作簿。 我试过调整代码来停止内存问题，但现在我似乎无法得到它的工作。

Sub Postcodesplitter() Dim b As Range, w As Long, c As Range, x As Long, d As Range, y As Long For Each b In Selection w = Len(b) If w = 8 And InStr(b, "-") = 0 Then b = Application.WorksheetFunction.Replace(b, 15 - w, 0, "-") For Each c In Selection x = Len(c) If x = 7 And InStr(c, "-") = 0 Then c = Application.WorksheetFunction.Replace(c, 13 - x, 0, "-") For Each d In Selection y = Len(d) If y = 6 And InStr(d, "-") = 0 Then d = Application.WorksheetFunction.Replace(d, 11 - y, 0, "-") Next Next Next End Sub 

这是我放在一起的原始代码，但它导致超过300个目标单元格的内存问题。 即使在最好的时候，我也是一个相当不好的编码器，但是从朋友那里得到了一些build议，我试了一下。

 Sub Postcodesplitter() Dim b As Range, x As Long If (Len(x) = 6) Then b = Application.WorksheetFunction.Replace(b, 11 - x, 0, "-") Else If (Len(x) = 7) Then b = Application.WorksheetFunction.Replace(b, 13 - x, 0, "-") Else If (Len(x) = 8) Then b = Application.WorksheetFunction.Replace(b, 15 - x, 0, "-") End Sub 

但是这只是在编译时抛出错误。 我觉得我错过了很简单的事情。

有小费吗？

Answer 1

如果这个数字是6-8，看起来好像要截断为比现有字符数less两个？ 如果是这样的话：

 Sub Postcodesplitter() Dim data Dim x as Long Dim y as Long data = Selection.Value For x = 1 to ubound(data,1) for y = 1 to ubound(data, 2) Select Case Len(data(x, y)) Case 6 to 8 data(x, y) = left(data(x, y), len(data(x, y)) - 2) end select next y next x selection.value = data End Sub