VBA в Excel

Выбор произвольной ячейки от текущей

К примеру, вам необходимо переместиться вправо от текущей ячейки на три ячейчки. Для этого существует функция Offset:

ActiveCell.Offset(0, 3).Activate

Синтаксис функции: expression.Offset(RowOffset, ColumnOffset), где RowOffset - перемещение по вертикали, ColumnOffset - перемещение по горизонтали. Если RowOffset, ColumnOffset положительные числа - перемещение идет вниз/влево, если RowOffset, ColumnOffset отрицательные - перемещение идет вверх/вправо.

Подсчет количества заполненных ячеек

К примеру, у вас есть выделенный диапазон ячеек от 1 до 10. В 11-ой ячейке вам надо вывести цифру, сколько ячеек заполнено какой-либо информацией. Вызов функции(в 11-ой ячейке): =ScetE(B4:H4), где B4:H4 - диапазон подсчитываемых ячеек.

Function ScetE(Ran As Range) As Long
Dim cell As Object
ScetE = 0 'обнуляем счетчик
For Each cell In Ran 'для всех ячеек в выбранном диапазоне
If (Not (IsEmpty(cell.Value))) Then 'Если ячейка не пустая
ScetE = ScetE + 1 'добавляем единицу
Else
If IsNumeric(cell.Value) Then 'проверяем не числовое ли значение номер строки 1
If (Not (cell.Value = 0)) Then ' а не равна ли она 0
ScetE = ScetE + 1 'добавляем единицу
End If
End If ' номер строки 2
End If
Next cell
End Function

Функция для создания файла xls

Вызов функции: Call CreateExcelFile

Function CreateExcelFile() As Long
On Error GoTo CatchErr
Const LF_SYMBOL As Byte = &HA
Const TAB_SYMBOL As Byte = &H9
Dim szFilePath As String
Dim szFileName As String
Dim szDefaultBuffer As String
Dim lFieldCount As Long
Dim lRowCount As Long
Dim ltempCount As Long
Dim ltempCount2 As Long
szFilePath = App.Path
If Right(szFilePath, 1) <> "\" Then szFilePath = szFilePath & "\"
szFileName = "TestExcel"
lFieldCount = 10
lRowCount = 10
Open szFilePath & szFileName & ".xls" For Append As #1
szDefaultBuffer = ""
'save field names
ltempCount = 1
Do While ltempCount <= lFieldCount
If ltempCount = 1 Then
szDefaultBuffer = "Field" & ltempCount
Else
szDefaultBuffer = szDefaultBuffer & Chr(TAB_SYMBOL) & "Field" & ltempCount
End If
ltempCount = ltempCount + 1
Loop
'can be skipped because Print put that symbol
'szDefaultBuffer=szDefaultBuffer & chr(LF_SYMBOL)
Print #1, szDefaultBuffer
'save field values
ltempCount = 1
Do While ltempCount <= lRowCount
szDefaultBuffer = ""
ltempCount2 = 1
Do While ltempCount2 <= lFieldCount
If ltempCount2 = 1 Then
szDefaultBuffer = "Value" & ltempCount & ":" & ltempCount2
Else
szDefaultBuffer = szDefaultBuffer & Chr(TAB_SYMBOL) & "Value" & ltempCount & ":" & ltempCount2
End If
ltempCount2 = ltempCount2 + 1
Loop
'can be skipped because Print put that symbol
'szDefaultBuffer=szDefaultBuffer & chr(LF_SYMBOL)
Print #1, szDefaultBuffer
ltempCount = ltempCount + 1
Loop
Close 1
CreateExcelFile = 0
Exit Function
CatchErr:
CreateExcelFile = Err.Number
End Function

Выбор данных из ниспадающего списка

Вопрос: Можно ли в Excel 97/2000 сделать так, чтобы в ячейке можно было выбрать только значения, хранящиеся в определенном столбце, например, в виде выпадающего списка?

Ответ:
1) Создаешь список значений
2) Выделяешь ячейку (столбец или строку), где будет производиться
подстановка из списка
3) Данные -> Проверка -> Параметры
- Тип данных: "Список"
- Источник: <указываешь на созданный список>
4) OK
5) При выделении ячейки справа будет появляться стрелка выпадающего списка.

Источник: http://www.vbnet.ru/