Excel VBA – 寻找简化循环的方法

我最近做了一个循环，每个单元格中的string，searchstring中的“_”，如果有一个切断了该位和任何字符后面。 看着代码，我意识到它可能太精细，可以缩短或简化，但我不太清楚如何去做。 有没有办法让这一点代码更有效率？

Sub Name_Change() Sheets("Sheet1").Activate Dim tg_row As Integer tg_row = 1 For Each nm_cl In Range("Table1[Name]") If InStr(1, nm_cl, "_", vbTextCompare) = 0 Then Range("Table1[Name]").Cells(tg_row, 1).Value = nm_cl.Value Else Range("Table1[Name]").Cells(tg_row, 1) = _ Left(nm_cl, InStr(1, nm_cl, "_", vbTextCompare) - 1) End If tg_row = tg_row + 1 Next nm_cl End Sub 

感谢您的帮助！

Answer 1

第一次尝试优化这将是要注意，你要多次调用InStr 。 您可以通过计算一次来加快速度，并存储结果。

除此之外，我会注意到大概Range("Table1[Name]")只有一列（否则你会覆盖其他列的数据的第一列）。 所以，你可以使用nm_clreplaceRange("Table1[Name]").Cells(tg_row, 1) 。 在这样做的时候，我们注意到nm_cl.Value = nm_cl.Value的冗余语句可以被删除。 这导致下面的代码：

 Sub Name_Change() Sheets("Sheet1").Activate Dim index As Long For Each nm_cl In Range("Table1[Name]") index = InStr(1, nm_cl, "_", vbTextCompare) If index <> 0 Then nm_cl = Left(nm_cl, index - 1) End If Next nm_cl End Sub 

如果您需要更高的效率，超出这个范围，您可以通过使用将数据加载到变体中

 dim data as Variant data = Range("Table1[Name]").Value 

处理VBA中的所有数据，然后将其放回工作表使用

 Range("Table1[Name]").Value = data 

这会提高你的速度，因为在Excel和VBA之间传输数据很慢，这意味着你将有1读和1写，而不是每行 1读和1写，但它将需要（小）重写你的algorithm为在变体中使用数组的语法与使用范围的语法不同。 请注意，如果超出65536行，这将不起作用。 我相信这是来自Excel 2003及更早版本的传统约束。

Answer 2

你可以调整你的循环，只修改包含“_”的单元格。

 If Not InStr(1, nm_cl, "_", vbTextCompare) = 0 Then Range("Table1[Name]").Cells(tg_row, 1) = _ Left(nm_cl, InStr(1, nm_cl, "_", vbTextCompare) - 1) End If 

编辑：

这是一个包含@ Degustaf的build议的工作示例。 只需更改范围的名称以适合您的工作表。

 Sub Name_Change() Dim selectedRange As Range Dim rangeData As Variant 'Array containing data from specified range Dim col As Long 'Selected column from range Dim row As Long 'Selected row from range Dim cellValue As String 'Value of selected cell Dim charPosition As Long 'Position of underscore Sheets("Sheet1").Activate Set selectedRange = Range("YOUR-NAMED-RANGE-HERE") If selectedRange.Columns.Count > 65536 Then MsgBox "Too many columns!", vbCritical ElseIf selectedRange.Rows.Count > 65536 Then MsgBox "Too many rows!", vbCritical Else rangeData = selectedRange.Value If UBound(rangeData, 1) > 0 And UBound(rangeData, 2) > 0 Then 'Iterate through rows For row = 1 To UBound(rangeData, 1) 'Iterate through columns For col = 1 To UBound(rangeData, 2) 'Get value of cell cellValue = CStr(rangeData(row, col)) 'Get position of underscore charPosition = InStr(1, cellValue, "_", vbTextCompare) 'Update cell data stored in array if underscore exists If charPosition <> 0 Then rangeData(row, col) = Left(cellValue, charPosition - 1) End If Next col Next row 'Overwrite range with array data selectedRange.Value = rangeData End If End If End Sub 

Answer 3

您可以使用用户定义的函数来返回单元格中的截断string。 工作表函数可能如下所示：

  Public function truncateAt( s as String) as string dim pos as integer pos = instr (1, s,"_") If pos> 0 then truncateAt= left (s, pos) Else truncateAt= s End If End function