Excel VBA - Ищете способы упрощения цикла

Question

Недавно я сделал цикл, который берет строку в каждой ячейке, ищет «_» в строке и, если есть, отрезает этот бит и любой символ после него. Глядя на код, я понял, что он может быть слишком сложным и может быть сокращен или упрощен, но я не совсем уверен, как это сделать. Есть ли способ сделать этот бит кода более эффективным?

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 реак d и 1 напишите в строке, но для этого потребуется небольшая перезапись вашего алгоритма, так как синтаксис для работы с массивом внутри варианта отличается от работы с диапазонами. Обратите внимание, что это не сработает, если вы выйдете за пределы 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 

EDIT:

Вот рабочий пример, который включает в себя @ предложения 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