旧的工作表macros观工作，新的工作表循环

使用代码删除所有标点和奇数字符。 我试图添加一个部分，它会在单元格的开始和结尾添加一个空格，以确保稍后的search能够正常工作。 它无休止地循环，所以我拿出了新的代码，但它仍然无休止地循环。

我试图closures并重新打开文件，它仍然无休止地循环。 一个旧的副本工作得很好。 为什么是这样？ （我不知道如何附加这些文件，任何帮助都会很棒。）

旧的代码和这个代码是相同的（我复制粘贴，并重新手动input，确保数次）。

我已经添加了另一个function，但它是一个不同macros中的简单单元格计数器。 我不明白为什么会影响这一点。

Option Explicit Sub RemovePunctuation() Dim cell As Range With CreateObject("vbscript.regexp") .Pattern = "[^A-Za-z\ ]" .Global = True For Each cell In Worksheets("Raw").Range("A2:A1000").SpecialCells(xlCellTypeConstants) cell.Value = .Replace(cell.Value, vbNullString) Next cell End With For Each cell In Worksheets("Raw").Range("A2:A1000").SpecialCells(xlCellTypeConstants) cell.Value = LCase(cell.Value) Next cell End Sub 

同一工作表上的其他代码 – 计算唯一的单词

 Sub ExtractWords() Dim X As Variant, S As Variant, S2 As Variant, S3 As Variant, str As Variant, key As Variant Dim oDict As Scripting.Dictionary Dim i As Double, j As Double, k As Double Dim Anchor As Range Set oDict = New Scripting.Dictionary With ThisWorkbook 'Clear past output With .Sheets("Output") .Range("a2:" & .Cells(.Rows.Count, .Columns.Count).Address).ClearContents End With 'Fill array with text to search With .Sheets("Raw") X = .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row).Value2 End With End With For i = LBound(X) To UBound(X) S = Split(X(i, 1), " ") For j = LBound(S, 1) To UBound(S, 1) If oDict.Exists(LCase(S(j))) Then oDict.Item(LCase(S(j))) = oDict.Item(LCase(S(j))) + 1 Else oDict.Add LCase(S(j)), 1 End If Next j Next i 'Output results to sheet "Output" With ThisWorkbook.Sheets("Output") For Each key In oDict.Keys Set Anchor = .Range("a" & Rows.Count).End(xlUp).Offset(1, 0) Anchor = key Anchor.Offset(0, 1) = oDict.Item(key) Next key .Range("a1:" & .Range("a" & .Rows.Count).End(xlUp).Offset(0, 1).Address).Sort .Range("b:b"), xlDescending End With End Sub 

添加一个列来计算有多less句子使用该单词。 （为什么我需要在每个句子的开头和结尾添加一个空格。）

 Option Explicit Sub CountCards() Worksheets("Output").Activate 'Range("C2:C5000").Formula = "=IF(COUNTIF(Raw!A:A,""* ""&A2&"" *"")=0,"""",COUNTIF(Raw!A:A,""* ""&A2&"" *""))" Range("C2:C5000").Formula = "=IF(COUNTIF(Raw!A:A,""* ""&A2&"" *"")=0,"""",COUNTIF(Raw!A:A,""* ""&A2&"" *""))" End Sub 

Answer 1

我的怀疑是它与计算有关。 您有一个插入公式的另一张表中引用列A的公式的过程。如果列C已经填入公式，则更改列A中的值（依赖项）可能会触发重新计算所有这些公式。

 Option Explicit Sub RemovePunctuation() Dim cell As Range Dim calc as Long '## Get the original calculation state: calc = Application.Calculation Application.Calculation = xlCalculationManual With CreateObject("vbscript.regexp") .Pattern = "[^A-Za-z\ ]" .Global = True For Each cell In Worksheets("Raw").Range("A2:A1000").SpecialCells(xlCellTypeConstants) cell.Value = .Replace(cell.Value, vbNullString) Next cell End With For Each cell In Worksheets("Raw").Range("A2:A1000").SpecialCells(xlCellTypeConstants) cell.Value = LCase(cell.Value) Next cell '## Reset the calculation to original state Application.Calculation = calc End Sub