Question

我最近做了一个循环，在每个单元格中取出字符串，搜索＆＃34; _＆＃34;在字符串中，如果有一个字母切断该位以及后面的任何字符。看看代码，我意识到它可能过于复杂，可以缩短或简化，但我不太清楚如何这样做。有没有办法让这段代码更有效率？

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]")只有一列（否则你会用其他列的数据覆盖第一列）。因此，您可以将Range("Table1[Name]").Cells(tg_row, 1)替换为nm_cl。在执行此操作时，我们注意到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次，但它会需要（次要）重写算法，因为在变体中使用数组的语法与使用范围不同。请注意，如果超出65536行，这将不起作用。我相信它是Excel 2003及更早版本的遗留约束。

Answer 2

您可以调整循环以仅修改包含＆＃34; _＆＃34;。

的单元格

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建议的工作示例。只需更改范围的名称即可适合您的工作表。

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

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

 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

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

3 个答案: