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

我最近做了一个循环，它在每个单元格中接收字符串，在字符串中搜索“_”，并且如果有一个将该位及其后面的任何字符切断。看着代码，我意识到它可能太精细，可以缩短或简化，但我不太清楚如何去做。有没有办法让这些代码更有效率？Excel VBA - 寻找简化循环的方法

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

谢谢你的帮忙！

来源

2014-10-16 bcwhite1618

关于'Table1 [Name]'范围有多大？少于65K行？ – Degustaf 2014-10-16 15:51:36

它改变了，但我没有看到它超过5K行 – bcwhite1618 2014-10-16 15:56:46

首先尝试优化此操作将注意到您要拨打InStr多次。你可以通过计算一次来加快速度，并存储结果。

除此之外，我会注意到大概Range("Table1[Name]")只有一列（否则你会用其他列的数据覆盖第一列）。所以，你可以用nm_cl代替Range("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之间transfering数据是缓慢的，这意味着你将有1次读取和1次写入，而不是1 REA的d和1每行写，但它需要对算法进行（小）重写，因为用于处理变量中的数组的语法与使用范围不同。请注意，如果超出65536行，这将不起作用。我相信这是来自Excel 2003及更早版本的传统约束。

来源

2014-10-16 16:04:51 Degustaf

是的，范围（“Table1 [Name]”）'只是Table1中的一列。我非常喜欢这种方法，但出于某种原因，当我替换这些代码时，它不起作用。连弹出错误都没有。我尝试用'If Not'代替你的'If'，因为它可能不喜欢“不等于”符号，但这也不起作用... – bcwhite1618 2014-10-16 17:43:27

我不确定。这个对我有用。您是否尝试过逐步查看每个步骤中的“nm_cl”和“index”？ – Degustaf 2014-10-16 17:51:45

我尝试了每一步，它看起来像数值不同步？所以我将'nm_cl = Left（nm_cl，index - 1）'改为'nm_cl.Value = Left（nm_cl，index - 1）'然后工作。不知道为什么它不同步，也许是因为'[Name]'范围从行= 2开始？ – bcwhite1618 2014-10-16 18:05:25

您可以调整您的循环以仅修改包含“_”的单元格。

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

来源

2014-10-16 16:09:26 Seth

这太棒了！我想试着将你的方法与@Degustaf融合在一起，但我一直在打嗝让它工作，并打嗝，我的意思是它不工作 – bcwhite1618 2014-10-16 17:46:10

您可以使用用户定义的函数返回单元格中的截断字符串。工作表函数可能看起来像：

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

来源

2014-10-16 19:52:25 DrMarbuse

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

回答

相关问题