» Excel VBA (часть 3)

Со мной-то что спорить?

Кем возвращается? Код в студию.

Меня не волнует, во сколько именно раз мой код быстрее Вашего

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

IsEmpty(expression) - Returns a Boolean value indicating whether a variable has been initialized.

The required expression argument is a Variant containing a numeric or string expression. However, because IsEmpty is used to determine if individual variables are initialized, the expression argument is most often a single variable name.

Remarks:
IsEmpty returns True if the variable is uninitialized, or is explicitly set to Empty; otherwise, it returns False. False is always returned if expression contains more than one variable. IsEmpty only returns meaningful information for variants.

Sub DelEmptyClmRws()
'Универсальный макрос для удаления пустых строк и колонок из листа
Dim R As Integer
Dim C As Integer
Dim I As Integer
Dim CheckCal As Integer
Dim CheckRaw As Integer
Dim ContrSum As Integer
'отменяем объединения ячеек, которые иногда создаются пользователями либо "кривыми" программами
ActiveSheet.UsedRange.MergeCells = False
'определям "рабочую зону" нашего листа
'строчки
R = ActiveSheet.UsedRange.Rows.Count
'колонки
C = ActiveSheet.UsedRange.Columns.Count
'ищем и удаляем пустые колонки
'задаем первую колонку, которая будет проверяться
CheckCol = 1
Do
ContrSum = 0
For I = 1 To R
If Cells(I, CheckCol).Value <> "" Then
'вводим контрольную сумму, если попадется хотя бы одна непустая ячейка
ContrSum = ContrSum + 1
End If
Next I
'если все ячейки пустые, удаляем колонку
If ContrSum = 0 Then
Columns(CheckCol).Delete Shift:=xlToLeft
'уменьшаем "рабочую зону" на единицу
C = C - 1
Else: CheckCol = CheckCol + 1
End If
Loop While CheckCol < C
'ищем и удаляем пустые строки
CheckRaw = 1
Do
ContrSum = 0
For I = 1 To C
If Cells(CheckRaw, I).Value <> "" Then
'вводим контрольную сумму, если попадется хотя бы одна непустая ячейка
ContrSum = ContrSum + 1
End If
Next I
'если все ячейки пустые, удаляем строчку
If ContrSum = 0 Then
Rows(CheckRaw).Delete Shift:=xlUp
'уменьшаем "рабочую зону" на единицу
R = R - 1
Else: CheckRaw = CheckRaw + 1
End If
Loop While CheckRaw < R
End Sub

прежде всего я бы заменил
If Cells(I, CheckCol).Value <> ""
на
If Len(Cells(I, CheckCol).Value) > 0

Потом разделил бы код на четыре части:

Len Function returns a Long containing the number of characters in a string or the number of bytes required to store a variable.

Sub DelEmptyClmRws_v2()
'Универсальный макрос для удаления пустых строк из листа
Dim R As Integer
Dim C As Integer
Dim I As Integer
Dim Y As Integer
Dim Z As Integer
Dim CheckCal As Integer
Dim CheckRow As Integer
Dim ContrSum As Integer
'объявляем массивы с номерами пустых строк и столбцов
Dim EmptCol(1 To 100) As Integer
Dim EmptRow(1 To 100) As Integer

'отменяем объединения ячеек, которые иногда создаются пользователями либо "кривыми" программами
ActiveSheet.UsedRange.MergeCells = False
'1. определям "рабочую зону" нашего листа
'строчки
R = ActiveSheet.UsedRange.Rows.Count
'колонки
C = ActiveSheet.UsedRange.Columns.Count

'2. ищем пустые колонки
'задаем первую колонку, которая будет проверяться
CheckCol = 1
Y = 0
Do
ContrSum = 0
For I = 1 To R
If Len(Cells(I, CheckCol).Value) > 0 Then
'вводим контрольную сумму, если попадется хотя бы одна непустая ячейка
ContrSum = ContrSum + 1
End If
Next I
'если все ячейки пустые, записываем номер колонки
If ContrSum = 0 Then
Y = Y + 1
EmptCol(Y) = CheckCol
End If
CheckCol = CheckCol + 1
Loop While CheckCol <= C

'3. ищем пустые строки
CheckRow = 1
Z = 0
Do
ContrSum = 0
For I = 1 To C
If Len(Cells(CheckRow, I).Value) > 0 Then
'вводим контрольную сумму, если попадется хотя бы одна непустая ячейка
ContrSum = ContrSum + 1
End If
Next I
'если все ячейки пустые, записываем номер строчки
If ContrSum = 0 Then
Z = Z + 1
EmptRow(Z) = CheckRow
End If
CheckRow = CheckRow + 1
Loop While CheckRow <= R

'4. удаляем пустые строки и колонки
For I = 1 To Y
Columns(EmptCol(I)).Delete Shift:=xlToLeft
EmptCol(I + 1) = EmptCol(I + 1) - I
Next I
For I = 1 To Z
Rows(EmptRow(I)).Delete Shift:=xlUp
EmptRow(I + 1) = EmptRow(I + 1) - I
Next I

End Sub

Да, чуть не забыл! Удалять сзаду надо начинать!

но что там произойдет с диапазонами

Надо только перед этим удалить подводные камни с листа (очистить ячейки).

Хочу предупредить: (может быть, уважаемый asbo об этом не знает), что ...

Вы еще за прошлое не расчитались...

Погодите малость - я Вам отповедь приготовил...