» Excel VBA (часть 3)

вот парочка полезный функций, которые всегда пригодятся.


Код: '******************************************************
'Procedure : SwitchNumToAlpha
'Function : Given Number equivalent Alphabet
'Requires : Number
'Returns : Alphabet
'Created By : Jay Sarsonas 6/21/2010
'******************************************************
Public Function SwitchNumberToAlphabet(inAlphaNumeric As Long) As String
Dim High
Dim Low

High = inAlphaNumeric \ 26
Low = inAlphaNumeric Mod 26

SwitchNumberToAlphabet = ""

If Low = 0 Then
Low = 26
High = High - 1
End If

If (High > 0) Then
SwitchNumberToAlphabet = Chr(Asc("A") + High - 1)
End If

SwitchNumberToAlphabet = SwitchNumberToAlphabet & Chr(Asc("A") + Low - 1)
End Function

'******************************************************
'Procedure: GetMaxDataRows
'Function: Identifies Max Record Rows given
' Worksheet and Range
'Requires: Worksheet and Range
'Returns: None
'Created by Jay Sarsonas 4/19/2010
'******************************************************
Public Function GetMaxDataRows(xSheetName As String, xRange As String) As Long
'Identify Max Used Rows
With Worksheets(xSheetName)
GetMaxDataRows = .Range(xRange & 65534).End(xlUp).Row
End With
End Function

'******************************************************
'Procedure: GetMaxDataColumns
'Function: Identifies Max Record Columns given
' Worksheet and Range
'Requires: Worksheet and Range
'Returns: None
'Created by Jay Sarsonas 8/23/2010
'******************************************************
Public Function GetMaxDataColumns(xSheetName As String, xRange As String) As Long
'Identify Max Used Rows
With Worksheets(xSheetName)
GetMaxDataColumns = .Range("IU1").End(xlToLeft).Column
End With
End Function

KorolCOOL

Цитата:

Я знаю один способ...

А чем Вас не устраивает мой пример? Это другой способ. Который не требует буквенного определения конечного столбца.

куда делось мое сообщение? я его почему-то не вижу

KF121

Цитата:

куда делось мое сообщение? я его почему-то не вижу

Если предыдущее, то я вижу

теперь и я, видать глюк какой-то был.

SAS888 спасибо помогло.

KF121

Цитата:

вот парочка полезный функций

функции может и полезные, но с выходом Excel 2007 несколько устарели
1) количество строк увеличено с 65536 до миллиона
2) количество столбцов увеличено c 256 (IV) до 16384 (XFD).
3) имя столбца может быть трех буквенным, и функция SwitchNumberToAlphabet для столбцов больше 27*26 (ZZ) вернет не то, что должна

я пока еще не сталкивался с такими объемами данных. и мне их хватало. а функции всегда можно подправить под те или иные нужды

Как узнать является ли содержимое строки S тем, что можно перевести в данные типа ДАТА?

KorolCOOL

Цитата:

Как узнать является ли содержимое строки S тем, что можно перевести в данные типа ДАТА?

Код:
Function IsDateStr(S)
IsDateStr = False
On Error GoTo notadate
d = DateTime.DateValue(S)
IsDateStr = True
If Year(d) = Year(CDate(0)) Then IsDateStr = False
notadate:
End Function

KorolCOOL

Цитата:

Как узнать является ли содержимое строки S тем, что можно перевести в данные типа ДАТА?

А что Вы подразумеваете под содержимым строки? Вообще-то, в Excel строка - это диапазон ячеек всех столбцов в строке листа. Если же S - это строковая переменная, то достаточно проверки
Код: If IsDate(S) Then...

Бинго. IsDate то, что нужно. Спасибо.

А не подскажете, если какая-нибудь функция, которая работала бы как IsDate но возвращала бы True если троковая переменная S содержит данные, которые можно не только перевести в Дату, но которые еще и подходят под какой-нибудь шаблон. А то IsDate возвращает True и на строку "2,1". А это уже перебор для моих целей.

KorolCOOL

Цитата:

А то IsDate возвращает True и на строку "2,1". А это уже перебор для моих целей.

Вариант 1:
Возможно, что Вам достаточно следующего:

Код: If Not IsNumeric(s) Then If IsDate(s) Then MsgBox CDate(s)

Добрый день

Помогите пожалуйста оптимизировать

Sheets("По сумме").Range("Z41").Copy
Sheets("По сумме").Range("Z47").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

TXP
With Sheets("По сумме")
.Range("Z47").Value = .Range("Z41").Value
End With

Спасибо

Сие до ума доведите пожалуйста, а то не работает.

Данный код должен удалять в листе "Приложение № 1" данные в указанных ячейках"F13:BA50", кнопка находится на листе "Расчет"

Private Sub CBut4_Click()

Sheets("Приложение № 1").Select
Range("F13:BA50").Select
Selection.ClearContents
Range("F13:M14").Select
Sheets("Расчет").Select
Range("H11").Select
End Sub

В данном случае все наоборот с листа "Расчет" данные должны переноситься на лист "Приложение № 1"

Private Sub CBut2_Click()
Range("O13:BJ50").Select
Selection.Copy
Sheets("Приложение № 1").Select
Range("F13:BA50").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("F13:M14").Select
Sheets("Расчет").Select
Range("H12").Select
Application.CutCopyMode = False
End Sub

Sheets("Приложение № 1").Range("F13:BA50").ClearContents

Спасибо заработало, по второму коду посоветуйте что нибудь

TXP
можно так
Sheets("Расчет").Range("O13:BJ50").Copy Destination:= _
Sheets("Приложение № 1").Range("F13:BA50")
или через буфер и PasteSpecial
Sheets("Расчет").Range("O13:BJ50").Copy
Sheets("Приложение № 1").Range("F13:BA50").PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Спасибо второй вариант подходит больше, т.к. так как первый копирует формулы а мне был необходим перенос контрольных данных.

TXP, smirnvlad
Dim vArr() As Variant
vArr = Range("O13:BJ50").Value
Range("F13:BA50").Value = vArr

asbo
у меня таким способом формат ячейки странно себя ведет
например исходная ячейка - денежный, куда копируем - текстовый
формат меняется, но отображается сумма со знаком доллара вместо рублей, приходится вставлять дважды, т.е.
Dim vArr() As Variant
vArr = Range("O13:BJ50").Value
Range("F13:BA50").Value = vArr
Range("F13:BA50").Value = vArr

smirnvlad, не знаю... Но предполагаю, что:
- ячейки назначения уже имеют, какой-то формат, или
- Ексел автоматом назначает им некий формат в зависимости от типа копируемых данных, или
- Возникают какие-то нюансы VBA, при которых он изъясняется только по-американски.

И все это может быть и в комбинации. Пока не могу предметно ответить - надо поэкспериментровать.

Попробуй всунуть до и после каждого действия:
Debug.Print Range("F13:BA50").NumberFormat

asbo

Цитата:

ячейки назначения уже имеют, какой-то формат

так и есть, т.е. excel сначала копирует данные, а потом форматирует их

почему тогда получаем $1.00, а не 1.00р., хотя формат тот же
после первого присвоения и после второго .NumberFormat и .NumberFormatLoacl совпадают, а .Value различаются

Просветите пожалуйста. Если я в программе использую переменные типа Object, то после выполнения программы, память, занимаемая этими переменными, автоматически освобождается или необходимо явно это сделать (насколько я знаю так: Set Var = Nothing)?

Добрый день

Подскажите как можно реализовать следующие:
1. При достижение определенного контрольного показателя в указанного в конкретной ячейке активизировался элемент управления (кнопка). грубо если значение ячейки А1 = 0 то кнопка "Печать" активна, если значение А1 отлично от 0 то кнопка не активна.
2. При нажатии кнопки "Печать" на листе "Расчет" распечатывались определенные листы (пример лист2, лист3 и т.д.) и при этом можно было задать определенное кол-во печати на тот или иной лист (например лист2 2 экз., лист3 1 экз.)

P.s. Повозможности если не затруднит напишете готовое решение т.к. в программировании не селен.

В модуле ЛИСТА задать процедуру

Код: Private Sub Worksheet_Change(ByVal Target As Range)

KorolCOOL

Цитата:

Если я в программе использую переменные типа Object, то после выполнения программы, память, занимаемая этими переменными, автоматически освобождается или необходимо явно это сделать (насколько я знаю так: Set Var = Nothing)?

Если вопрос именно по механизму выделения и освобождения памяти VBA, то лучше специализированный поиск по нему и делать. И по времени жизни и области видимости переменных в VBA.

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

Если же область видимости шире, чем процедура - то надо явно уничтожать. Говорят, что иногда и перед переназначением, но я не сталкивался. И, что касается Nothing, то, он не всегда корректно действует. Часто приходится использовать метод объекта .Close. В ответственных местах, чтобы не забивать голову я использую оба. Столкнулся с этим с некоторыми объектами Recordset.


Добавлено:
ZlydenGL
Наверное лучше: If Target = Range("$A$1")
Ни хрена не лучше :)

Добавлено:
smirnvlad
У меня все нормально работает, без трансформаций форматов. Вот пример. В ячейках A5-A7 данные. B1-B7 ссылаются на A5-A7. Копирование идет в D5-D7.

Код:
Sub sb_Copy()
Dim rSrc As Range, rTgt As Range
Dim vArr() As Variant

Set rSrc = Range("B5:B7")
Set rTgt = rSrc.Offset(0, 2)

'Debug.Print "- - - -" & vbLf: Call sb_Debug(rSrc): Call sb_Debug(rTgt)
vArr = rSrc.Value
Debug.Print "- - - -" & vbLf: Call sb_Debug(rSrc): Call sb_Debug(rTgt)
rTgt.Value = vArr
Debug.Print "- - - -" & vbLf: Call sb_Debug(rSrc): Call sb_Debug(rTgt)

End Sub

Sub sb_Debug(pRng As Range)
Dim cl As Range
For Each cl In pRng.Cells
With cl
Debug.Print .Address & "; " & _
.Formula & "; " & _
.Value & "; " & _
.NumberFormat & "; " & _
.NumberFormatLocal
End With
Next
Debug.Print vbLf
End Sub

Напишите код пожалуста.
Если значение формулы в ячейке А1 равно = 0, то CBut1.Enabled = True
Если значение формулы в ячейке А1 не равно = 0, то CBut1.Enabled = False