Блог

Я ищу в тексте в первом столбце определенные слова, а когда они будут найдены, скопируйте и вставьте соседний столбец в другое место.

У меня есть этот код, который отлично работает, если текст состоит именно из этих слов, но если там есть что-то еще, он терпит неудачу (т. е. супер консолидатор).

Я все еще очень новичок в VBA и только что адаптировал какой-то другой код, чтобы добраться до этого момента. Я полагаю, что функция поиска была бы хорошим способом для этого, но я не могу понять, как избежать бесконечных циклов. Любая помощь здесь будет признательна

 Sub Test()
    Dim lr As Long
    Dim r As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in column A
    For r = 1 To lr
'       Check value on entry
        If (Cells(r, "A") = "Super") Or (Cells(r, "A") = "Pension") Or (Cells(r, "A") = "SMSF") Then
'           Copy column B and paste in C where found
            Cells(r, "B").Select
            Selection.Copy
            ActiveCell.Offset(0, 1).PasteSpecial    
        End If
    Next r 
End Sub
 

То, что вы ищете, называется сравнением строк с подстановочными знаками. И вы можете использовать оператор VBA, подобный оператору, для достижения вашего результата

 If (Cells(r, "A") Like "Super*") Or (Cells(r, "A") Like "Pension*") Or (Cells(r, "A") Like "SMSF*") Then
 

Здесь * in Super* означает, что текст должен начинаться с «Супер», и после этого в нем может быть все, что угодно.
Если вы хотите найти, содержит ли ячейка «Супер» в любом месте, вы можете использовать *Super* — * на обоих концах Super

Чтобы иметь более надежный код, я переместил «сигнальные» слова, которые вы проверяете, в массив в начале подзаголовка.

То же самое касается индексов столбцов столбца, который вы хотите скопировать, и целевого индекса.

Таким образом, гораздо проще вносить коррективы, если требования меняются, например, искать четвертое слово и т. Д.

Кроме того, вам следует избегать неявных ссылок на ячейки. Вот почему я добавил переменную ws-вам нужно изменить имя вашего листа.

Кроме того, я добавил универсальную функцию isInArray , которая принимает значение ячейки плюс массив со значениями поиска и возвращает значение true или false. Здесь like реализован оператор -.

Вам не нужно выбирать-копировать/вставлять значения — вы можете просто записать их в целевую ячейку: .Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value .

Но имейте в виду: если у вас много данных, было бы разумнее загрузить все в массив и работать над этим … но это следующий урок, который нужно усвоить 😉

 Option Explicit

Public Sub copyValues()

    Dim arrLookupValues(2) As Variant
    arrLookupValues(0) = "Super"
    arrLookupValues(1) = "Pension"
    arrLookupValues(2) = "SMSF"
    
    Const sourceColumnIndex As Long = 2 'take value from column B
    Const targetColumnIndex As Long = 3 'write value to colum C
    
    application.screenupdating = false
    
    Dim lr As Long
    Dim r As Long
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")    'adjust this to your needs
    
    With ws
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For r = 1 To lr
    '       Check value on entry
            If isInArray(.Cells(r, 1).value, arrLookupValues) Then
    '           write value of column B (2) to C (3)
                .Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
            End If
        Next r
    End With

    application.screenupdating = true
End Sub


Private Function isInArray(value As Variant, arrLookFor As Variant) As Boolean
Dim i As Long
For i = LBound(arrLookFor) To UBound(arrLookFor)
    If value like arrLookFor(i) amp; "*" Then
        isInArray = True
        Exit For
    End If
Next
End Function