Превращение формулы, содержащей Loop, если или и еще, в код VBA

Question

Две формулы доставляют мне много хлопот.Раньше я вручную вставлял формулу в первую строку, столбец, а затем копировал и вставлял ее во все столбцы.Вот две формулы для

Column A: =(IF(C2="","",IF(LEFT(C2,3)="Bus","BU CRM","CSI ACE")))

Column B:  =IF(C2="","",IF(LEFT(C2,3)="CSI", "",RIGHT(C2,LEN(C2)-14)))

Вот мои попытки

Столбец A:

`FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For m = 1 To FinalRow
If Cells.Left(m, 3) = Bus Then Cells(m, 1) = "BU CRM" Else Cells(m, 1) = "CSI ACE"
Next m
End If`

Столбец B:

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

For J = 1 To FinalRow

If Cells(J, 3) = "" Or Cells.Left(J, 3) = "CSI" _
Then Cells(J, 2) = "" _
Else Cells(J, 2) = Right.(Cells(J, 3) - 14) _

Next J

End If

По сути, мой код для столбца A для просмотра столбца C, и если ячейка в первых 3 буквах столбца C - это "Bus", то столбец A должен быть "BU CRM", в противном случае он должен быть "CSI ACE"

Принимая во внимание, что столбец B должен смотреть на столбец C, и если ячейка в столбце C начинается с "CSI", она должна вернуться в столбец B "".Если столбец C не начинается с «CS», верните последние 14 букв / цифр в столбец B.

Я надеюсь, что разъяснил мою проблему и вопрос.

Answer 1

Работа с большим количеством данных может обложить налогом вашу процедуру, если она выполняется на рабочем листе. Для этого необходимо заполнить массив всеми данными, а затем изменить все в нем, чтобы в итоге вставить его обратно на лист.Вот как:

Option Explicit

Sub FillColumns()

    Dim arrData As Variant, LastRow As Long, i As Long, ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") 'change the name of the sheet to the one you are doing the code

    With ws
        LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        arrData = .Range("A2", .Cells(LastRow, "C")).Value
        For i = 1 To UBound(arrData)
            If arrData(i, 3) Like "Bus*" Then
                arrData(i, 1) = "BU CRM"
            Else
                arrData(i, 1) = "CSI ACE"
            End If
            If arrData(i, 3) Like "CSI*" Or arrData(i, 3) = vbNullString Then
                arrData(i, 2) = vbNullString
            Else
                arrData(i, 2) = Right(arrData(i, 3), 14)
            End If
        Next i
        .Range("A2", .Cells(LastRow, "C")).Value = arrData
    End With

End Sub