Мой код будет делать то, что я хочу, но не эффективно. Пользователь вставит ровно пять столбцов и переменное количество строк на лист «Resp» в диапазоне C: G. Добавочный номер добавляется к строке в диапазоне B. Диапазон С примет имя и фамилию и изменится на фамилию, имя. Диапазоны D & F в настоящее время проверяют только длину текста и сокращают, если они превышают определенное число. Диапазон E заменяет 1 из 2 возможных строк буквой Y или N. Последний, диапазон G форматирует дату в "m-dd-yy" из "mm-dd-yyyy".
Проблема в том, что для вставки 10 строк требуется приблизительно 2,2 с (всего 50 ячеек). Я экспериментирую с новыми возможностями, но могу использовать дополнительные глаза в своем коде, чтобы увидеть, что можно реорганизовать.
Я сделал несколько поисков в Google, перечитал документы и просмотрел некоторые другие проблемы SO, но ничто не достаточно близко к тому, что у меня здесь.
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Or Intersect(Target, Range("G:G")) Is Nothing Or Target.Columns.Count <> 5 Then
Exit Sub
Else: If VBA.IsEmpty(Target.Cells(1, 1)) = True Then Exit Sub
End If
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim nSheet As Worksheet
Dim nRange(5) As Range
Dim bRange As Range
'The reason for this bRange is that I decided I needed it and don't want
'to update the range array just yet, long task
Dim nLen As Integer
Dim numLast As Long
Dim fnStr() As String
Dim rplStr As String
Set nSheet = Worksheets("Resp")
Set bRange = nSheet.Range("B" & (Target.Row) & ":B" & (Target.Row + Target.Rows.Count - 1))
Set nRange(1) = nSheet.Range("C" & (Target.Row) & ":C" & (Target.Row + Target.Rows.Count - 1))
Set nRange(2) = nSheet.Range("D" & (Target.Row) & ":D" & (Target.Row + Target.Rows.Count - 1))
Set nRange(3) = nSheet.Range("E" & (Target.Row) & ":E" & (Target.Row + Target.Rows.Count - 1))
Set nRange(4) = nSheet.Range("F" & (Target.Row) & ":F" & (Target.Row + Target.Rows.Count - 1))
Set nRange(5) = nSheet.Range("G" & (Target.Row) & ":G" & (Target.Row + Target.Rows.Count - 1))
'The intent is for the user to paste material that follows a certain format and is exactly 5 columns in length
'Right now they must paste in C:G, but I might change this to make it more user-friendly
'This range array probably isnt necessary, but does that affect execution speed as opposed
'to using a single Range variable that gets adjusted frequently?
If VBA.IsNumeric(bRange.Cells(0, 1)) = False Then
numLast = 0
Else
numLast = bRange.Cells(0, 1).Value
End If
For i = 0 To (Target.Rows.Count - 1)
'If it is possible to do some of these tasks as a batch rather than per cell
'that seems to be what is lagging this down
bRange.Cells(i + 1, 1).Value = numLast + i + 1
'Keeps track of the last number already on the sheet so we know whats next
fnStr() = Split(nRange(1).Cells(i + 1, 1))
'Do this for every cell in C that was pasted over
'Rearranges first name last name to last name, first name
On Error Resume Next
'Strings that do not have a space will cause error, so I took a temporary shortcut rather than handling error
nRange(1).Cells(i + 1, 1).Value = fnStr(1) & ", " & fnStr(0)
On Error GoTo 0
nLen = Len(nRange(2).Cells(i + 1, 1))
'Length of each cells text to determine if it will be shrunk
If nLen > 60 Then nRange(2).Cells(i + 1, 1).ShrinkToFit = True
'Could this be done over the entire column or does it need to be done
'one-at-a-time
If nRange(3).Cells(i + 1, 1).Text = "Read Answer" Then
rplStr = Replace(nRange(3).Cells(i + 1, 1), "Read Answer", "Y")
nRange(3).Cells(i + 1, 1) = rplStr
Else
rplStr = Replace(nRange(3).Cells(i + 1, 1), "We'll notify you when they answer.", "N")
nRange(3).Cells(i + 1, 1) = rplStr
End If
'This is probably the worst part of it so Im experimenting with other options now
Next
'The rest of the code is irrelevant
Предпочтительно, он должен выполняться намного быстрее, чем текущие строки 2,2 с / 10. Я не знаю, сколько времени можно сэкономить, но я сделал комментарии в коде, где я думаю, что проблемы могут быть.