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 - 尋找簡化循環的方法

回答

相關問題