BeS Yara пишет:... в MSDN обычно хожу искать конкретные свойства, а общее описание часто просматриваю по диагонали...
С моей точки зрения, начинать надо не с MSDN, а со встроенной справки по VBA. Так проще и эффективнее. MSDN - это уж если информации из встроенной справки не хватило.
BeS Yara пишет:... заведу ка я у себя в записках раздел и для VBA...
В таком случае ещё несколько советов.
1. Общие:
- без необходимости не используйте методы Activate и Select, т.к. они сильно замедляют работу макроса;
- при большом количестве операций по изменению содержимого ячеек, а особенно - по оформлению, отключайте перерисовку изображения на экране с помощью свойства ScreenUpdating объекта Application, что и ускорит работу макроса, и избавит пользователя от необходимости наблюдать процесс перерисовки.
2. По коду обсуждаемого макроса.
2.1. Определение наличия в книге листов с заданными кодовыми именами.
Фрагмент
Dim SourceListCodeName: SourceListCodeName = "Лист1"
Dim TargetListCodeName: TargetListCodeName = "Лист2"
Dim srcList, trgtList
srcList = GetListName(SourceListCodeName)
trgtList = GetListName(TargetListCodeName)
'проверяем что листы указаны верно
If IsBool(srcList) Then MsgBox "Имя листа-источника задано неправильно!", vbCritical
If IsBool(trgtList) Then MsgBox "Имя целевого листа задано неправильно!", vbCritical
If IsBool(srcList) Or IsBool(trgtList) Then Exit Sub
лучше заменить на такой
Dim objSrc As Object, objTrg As Object
On Error Resume Next
Set objSrc = Лист1
If Err.Number = 0 Then
Set objTrg = Лист2
If Err.Number <> 0 Then
Err.Clear
End If
Else
Err.Clear
End If
On Error GoTo 0
If objSrc Is Nothing Or objTrg Is Nothing Then
MsgBox "Кодовое имя листа-источника или (и) листа-приёмника задано неверно.", vbCritical
Else
'MsgBox objSrc.Name & vbNewLine & objTrg.Name, vbInformation
'Здесь должен быть код обработки данных
'...
End If
В дальнейшем коде переменные objSrc и objTrg можно будет использовать вместо выражений Worksheets(srcList) и Worksheets(trgtList) (соответственно).
Кроме того, станут ненужными функции GetListName() и IsBool().
2.2. Определение границ исходных данных на листе.
Фрагмент
MaxRowIteration = 50 'ограничение при проходе строк
MaxColumnIteration = 100 'ограничение при проходе столбцов
Dim LastDataRow, LastDataColumn
'перебираем строки в первой колонке пока не наткнёмся на пустую.
i = FirstDataRow - 1
Do
i = i + 1
tmp = Sheets(srcList).Cells(i, FirstColumn).Value
Loop Until StrComp(tmp, "", vbTextCompare) = 0 Or IsNull(tmp) Or i = MaxRowIteration
LastDataRow = i - 1
лучше заменить на оператор LastDataRow = Worksheets(srcList).Range("a1").CurrentRegion.Rows.Count
Фрагмент
i = FirstColumn 'колонку дат(первая колонка диапазона) сразу пропускаем, поэтому без "-1"
Do
i = i + 1
If Len(Sheets(srcList).Cells(NameDataRow, i).Value) > 0 And Len(Sheets(srcList).Cells(CodeDataRow, i).Value) > 0 Then
tmp = True
Else
tmp = False
End If
Loop Until Not tmp Or i = MaxColumnIteration
LastDataColumn = i - 1
лучше заменить на оператор LastDataColumn = Worksheets(srcList).Range("a1").CurrentRegion.Columns.Count
2.3. Подсчёт среднего арифметического.
Фрагмент
tmp = 0: k = 0
For j = FirstDataRow To LastDataRow 'строка
tmp = tmp + Sheets(srcList).Cells(j, i).Value
k = k + 1
Debug.Print tmp
Next
Sheets(trgtList).Cells(2, i - FirstColumn) = tmp / k
лучше заменить на такой
With Worksheets(srcList)
Worksheets(trgtList).Cells(2, i - FirstColumn) = Application.WorksheetFunction.Average(.Range(.Cells(FirstDataRow, i), .Cells(LastDataRow, i)))
End With