Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Переменные


Rambler's Top100


Counter CO.KZ

  1. Как увеличить размер массива, но сохранить все данные находящиеся в этом массиве ? 2004
  2. Как проверить содержит ли переменная ошибку ?
    Как проверить является ли переменная датой ?
    Как проверить является ли переменная числом ?
    2004
  3. Как преобразовать первую букву каждого слова в прописную ? 15.02.2005
  4. Как преобразовать все буквы в прописные [ВЕРХНИЙ РЕГИСТР] ? 24.03.2006
  5. Как преобразовать все буквы в строчные [нижний регистр] ? 24.03.2006
  6. Как определить является ли указанная буква прописной [ВЕРХНИЙ РЕГИСТР] ? 08.09.2007
  7. Как определить является ли указанная буква строчной [нижний регистр] ? 08.09.2007
  8. Как сохранить значение переменной даже после окончания работы макроса ?
    Как использовать переменную находящуюся в другом модуле ?
    2004
  9. Как создать строку, повторяющую текст заданное число раз [без цикла] ? 06.08.2006
  10. Как перебрать все символы в строке ? 20.04.2007
  11. Как подсчитать количество повторов искомого текста в другом тексте ? 12.06.2007
  12. Как определить позицию появления одной строки внутри другой, с учётом символов подстановки [без цикла] ? 04.01.2010
  13. Как удалить текст, находящийся между двумя парными скобками, включая сами скобки ? 13.03.2012
  14. Как перевернуть текст (реверс текста) ? NEW 24.09.2016
  15. Как определить содержит ли строка кириллицу или латиницу [без цикла] ? 16.11.2010
  16. Как определить содержит ли строка цифры [без цикла] ? 17.11.2010
  17. Как определить является ли строка адресом или именем ячейки/диапазона ? NEW 26.12.2015
  18. Как "преобразовать" двухмерный массив (столбец) в одномерный (строка) ? 18.02.2007
  19. Как "отобразить" данные одномерного массива с помощью функции MsgBox [без цикла] ? 04.07.2010
  20. Как получить нужный столбец многомерного массива [без цикла] ? 17.06.2007
  21. Как получить минимальное, максимальное, среднее арифметическое, а также сумму и произведение всех чисел массива [без цикла] ? 11.06.2007
  22. Как получить сумму всех чисел двух одномерных массивов, а также двух столбцов многомерного массива [без цикла] ? 17.06.2007
  23. Как получить сумму произведений двух одномерных массивов (имеющих одну и туже размерность), а также двух столбцов многомерного массива [без цикла] ? 17.06.2007
  24. Как получить одномерный массив, состоящий из значений диагонали диапазона [без цикла] ? 12.12.2014
  25. Как получить случайное число в заданном диапазоне ? 11.06.2007
  26. Как сгенерировать массив случайных и неповторяющихся чисел ? 10.06.2010
  27. Как сгенерировать пароль, например, для защиты листа, книги ? 06.06.2010
  28. Как очистить коллекцию, т.е. удалить все элементы коллекции, в т.ч. и без цикла ? 20.06.2014
  29. Как изменить значение логической переменной на противоположное (без проверки) ? NEW 20.06.2016
  30. Как определить день недели для указанной даты ? 21.06.2007
  31. Как вычислить количество дней между двумя датами ? 18.04.2007
  32. Как конвертировать текст, типа "01 Мая 2017" или "01 May 17" в дату ? NEW 03.06.2017
  33. Как программно получить название месяца ? 04.02.2011
  34. Как программно получить название дня недели ? 04.02.2012

  • Ответ :
  • Dim iArray()
    ReDim Preserve iArray(100)
    ' Текст программы, например, заполнение массива
    ReDim Preserve iArray(200)
    Примечание : В инструкции Dim нельзя определять размерность массива.
  • Ответ :
  • If IsError(iData) = True Then MsgBox "Здесь есть ошибка !!!"
    
    If IsDate(iData) = True Then MsgBox "Здесь находится дата"
    If IsNumeric(iData) = True Then MsgBox "Это и впрямь число"
    Обратите внимание на отличие Basic функции IsNumeric и стандартной функции рабочего листа ЕЧИСЛО/IsNumber :
    MsgBox IsNumeric(123)
    MsgBox IsNumeric("123")
    
    MsgBox  Application.IsNumber(123)
    MsgBox  Application.IsNumber("123")
    
    MsgBox  IsNumeric(Empty) 'IsNumeric(Range("IV65536"))
    MsgBox  Application.IsNumber(Empty) 'Application.IsNumber(Range("IV65536"))
    

  • Ответ :
  • iText = "маЗуриков ПетР пЕТровиЧ"
    
    iProperText = StrConv(iText, vbProperCase) ' Or
    iProperText = StrConv(iText, 3) ' Вариант I.
    
    iProperText = Application.Proper(iText) iProperText = WorksheetFunction.Proper(iText) iProperText = Excel.Application.Proper(iText) iProperText = Excel.WorksheetFunction.Proper(iText) iProperText = Application.WorksheetFunction.Proper(iText) ' Вариант II.

  • Ответ :
  • iText = "ТексТ" ' "текст"
    
    iUpText = UCase(iText) ' Вариант I.
    
    iUpText = StrConv(iText, vbUpperCase) ' Or iUpText = StrConv(iText, 1) ' Вариант II.
    iUpText = Format(iText, ">") ' Вариант III.

  • Ответ :
  • iText = "ТЕкСТ" ' "ТЕКСТ"
    
    iLwText = LCase(iText) ' Вариант I.
    
    iLwText = StrConv(iText, vbLowerCase) ' Or iLwText = StrConv(iText, 2) ' Вариант II.
    iLwText = Format(iText, "<") ' Вариант III.

  • Ответ :
  • iSymbol = "a" '"A"
    
    If iSymbol = UCase(iSymbol) Then
       MsgBox "Да", vbExclamation, ""
    Else
       MsgBox "Нет", vbExclamation, ""
    End If
    Для преобразования к верхнему регистру можно использовать и другие варианты [FAQ82]
  • Ответ :
  • iSymbol = "z" '"Z"
    
    If iSymbol = LCase(iSymbol) Then
       MsgBox "Да", vbExclamation, ""
    Else
       MsgBox "Нет", vbExclamation, ""
    End If
    Для преобразования к нижнему регистру можно использовать и другие варианты [FAQ83]
  • Ответ : Скачать пример

    Об'явите переменную как Public и расположите её описание перед программами и функциями.
    Значение такой переменной будет сохраняться до следущего её программного изменения или до закрытия файла.
    Переменная об'явленная на уровне проекта (Public), доступна во всех программных модулях рабочей книги, без передачи её в качестве аргумента.

    В некоторых случаях, например, после создания ActiveX элементов управления, значение такой переменной будет "сброшено", т.е. значение переменной типа Byte, Integer, Long, Currency, Single, Double, Date станет 0 , Boolean - False , Variant - Empty , String - "" , а Object - Nothing

    Статья на официальном сайте, где говорится о том, что копирование листа, также может привести к подобному эффекту : Public Variables May Be Lost When You Copy a Worksheet
  • Ответ :
  • iText = "Добро пожаловать на сайт "
    iCount = 5  ' количество повторений
    
    iReptText = Application.Rept(iText, iCount)
    iReptText = WorksheetFunction.Rept(iText, iCount)
    iReptText = Excel.Application.Rept(iText, iCount)
    iReptText = Excel.WorksheetFunction.Rept(iText, iCount)
    iReptText = Application.WorksheetFunction.Rept(iText, iCount)
    
    Если нет необходимости в использовании переменных, то :
    iReptText = Application.Rept("Повторяющийся текст" & vbCrLf, 5)
    MsgBox iReptText
    Примечание : Максимально допустимое количество символов в новой строке не может превышать 32767

    Совет : Для генерации строки, содержащей указанное число пробелов используйте функцию Basic - Space, а для генерации строки, содержащей указанное число повторяющегося символа - String
  • Ответ :
  • iText = "Строка, содержащая $, №, ?, а также A, B, C"
    For iCount = 1 To Len(iText)
        iSymbol = Mid(iText, iCount, 1)
        MsgBox iSymbol
    Next

  • Ответ :

    Для того, чтобы определить сколько раз встречается в нужной строке искомый текст, который может быть как отдельным символом, так и набором символов, можно использовать любую из двух нижеприведённых функций. Причём, при подсчёте Вы можете также задать и способ сравнения, так, например, в первом примере демонстрирующем вызов функции, регистр символов учитывается, а во втором примере, соответственно, не учитывается.
  • Private Function CountRepeat&(Text$, Search$, _
        Optional Register As Boolean = True)
        ' MS Excel 95, 97, 2000, XP, ...
        If Register = True Then
           CountRepeat& = Len(Text$) - _
           Len(Application.Substitute(Text$, Search$, ""))
        Else
           CountRepeat& = Len(Text$) - _
           Len(Application.Substitute(LCase(Text$), LCase(Search$), ""))
        End If
    End Function
    
    Private Sub Test()
        iResult1 = _
        CountRepeat("ТЕКСТ, содержащий различные СИМВОЛЫ", "о")
    
        iResult2 = _
        CountRepeat("ТЕКСТ, содержащий различные СИМВОЛЫ", "о", False)
    End Sub
    Private Function CountRepeat&(Text$, Search$, _
        Optional CompareMethod& = vbBinaryCompare)
        ' MS Excel 2000, XP, ...
        CountRepeat& = Len(Text$) - _
        Len(Replace(Text$, Search$, "", , , CompareMethod&))
    End Function
    
    Private Sub Test()
        iResult1 = _
        CountRepeat("ТЕКСТ, содержащий различные СИМВОЛЫ", "о")
    
        iResult2 = _
        CountRepeat("ТЕКСТ, содержащий различные СИМВОЛЫ", "о", vbTextCompare)
    End Sub

  • Ответ :

    Для того, чтобы определить позицию появления одной строки внутри другой можно применить Basic функцию InStr, однако, если при поиске необходимо использовать символы подстановки ? и *, то в таком случае Вы можете воспользоваться стандартной функцией рабочего листа ПОИСК/Search
  • iText$ = "Текст, в котором нам необходимо найти барона Врангеля [1878-1928]"
    
    iResult = Application.Search("Вр?нгел", iText$)
    
    If Not IsError(iResult) Then
       MsgBox "Текст начинается с позиции# " & iResult, , ""
    Else
       MsgBox "Искомый текст не найден", , ""
    End If
    iText$ = "Текст, в котором нам необходимо найти капитана Врунгеля"
    
    iResult = Application.Search("Вр?нгел", iText$)
    
    If IsNumeric(iResult) = True Then
       MsgBox "Текст начинается с позиции# " & iResult, , ""
    Else
       MsgBox "Искомый текст не найден", , ""
    End If
    iText$ = "Текст, где вроде бы есть барон Мюнхгаузен"
    
    If iText$ Like "*Мюнх*аузен*" Then
       MsgBox "Текст начинается с позиции# " & _
       WorksheetFunction.Search("Мюнх*аузен", iText$), , ""
    Else
       MsgBox "Искомый текст не найден", , ""
    End If
    Примечание :
    - Максимально допустимое количество символов в строке не должно превышать 32767
    - По умолчанию поиск начинается с первого символа, однако, это легко исправить, если использовать третий(необязательный) аргумент функции, например, Application.Search("Текст", "Внутр_текста", 5)
    - Если нет необходимости в определении позиции вхождения, то для определения наличия искомой строки, достаточно всего лишь использовать оператор Like
  • Ответ :

    Для того, чтобы удалить текст, находящийся между двумя парными скобками [ ], включая сами скобки, можно использовать любую из нижеопубликованных функций. Обратите внимание на то, что данные функции можно использовать и при работе со скобками ( ) и { } , естественно, заменив "*[[]*]*" на "*(*)*" или "*{*}*" и использовав поиск не_нужных скобок (VB функция InStr). Если же с реализацией подобной замены, возникли трудности, то в примере можно найти универсальную функцию, позволяющую указать нужный "тип" скобок.

    Обратите внимание на то, что парными скобками считаются - первая открывающая и следующая за ней, закрывающая скобка.
  • Private Function DeleteTextInBrackets$(iText$)
        Dim iStart%, iLength%
        Do While iText Like "*[[]*]*"
           iStart = InStr(iText, "[")
           iLength = InStr(iStart, iText, "]") - iStart + 1
           iText = Application.Replace(iText, iStart, iLength, "")
        Loop
        DeleteTextInBrackets = iText
    End Function
    Private Function DeleteTextInBrackets$(iText$)
        Dim iStart&, iEnd&
        Do While iText Like "*[[]*]*"
           iStart = InStr(iText, "[")
           iEnd = InStr(iStart, iText, "]")
           iText = Mid(iText, 1, iStart - 1) & Mid(iText, iEnd + 1)
        Loop
        DeleteTextInBrackets = iText
    End Function
    Private Function DeleteTextInBrackets$(iText$) 'XL97
        Dim iStart%, iLength%
        Do While iText Like "*[[]*]*"
           iStart = InStr(iText, "[")
           iLength = InStr(iStart, iText, "]") - iStart + 1
           iText = Application.Substitute(iText, Mid(iText, iStart, iLength), "")
        Loop
        DeleteTextInBrackets = iText
    End Function
    Private Function DeleteTextInBrackets$(iText$) 'XL2000
        Dim iStart&, iLength&
        Do While iText Like "*[[]*]*"
           iStart = InStr(iText, "[")
           iLength = InStr(iStart, iText, "]") - iStart + 1
           iText = Replace(iText, Mid(iText, iStart, iLength), "")
        Loop
        DeleteTextInBrackets = iText
    End Function
    Примечание : Максимально допустимое количество символов в строке не должно превышать 32767 (актуально только для первого и третьего варианта)

    Комментарий : Если же Вам нужно просто удалить весь текст, начиная с первой открывающей и заканчивая последней закрывающей скобкой, то начиная с Microsoft Excel 2000 достаточно использовать такой вариант :
    Private Function DeleteTextInBracket2$(iText$) 'XL2000
        Dim iStart%, iLength%
        If iText Like "*[[]*]*" Then
           iStart = InStr(iText, "[")
           iLength = InStrRev(iText, "]") - iStart + 1
           iText = Application.Replace(iText, iStart, iLength, "")
        End If
        DeleteTextInBrackets = iText
    End Function

  • Ответ :

    Для того, чтобы перевернуть текст, т.е. вместо "абырвалГ" получить "Главрыба" или наоборот в Microsoft Excel 95-97 можно воспользоваться стандартной функцией рабочего листа =ВЫЗВАТЬ()

    Но если сие необходимо проделать программно, но далее опубликовано несколько функций, которые могут это осуществить :
  • Public Function TextReverse$(Source$) 'Microsoft Excel 95
        Dim iCount1&, iCount2&
        iCount2 = Len(Source): TextReverse = Space$(iCount2)    
        For iCount1 = 1 To iCount2
            Mid$(TextReverse, iCount1, 1) = Mid$(Source, iCount2 - iCount1 + 1, 1)
        Next
    End Function
    Public Function TextReverse2$(Source$) 'Microsoft Excel 95
        Dim iCount&, iCount1&, iCount2&
        iCount = Len(Source): TextReverse2 = Space$(iCount)    
        For iCount1 = iCount To 1 Step -1
            iCount2 = iCount2 + 1
            Mid$(TextReverse2, iCount2, 1) = Mid$(Source, iCount1, 1)
        Next
    End Function
    Public Function TextReverse3$(Source$) 'Microsoft Excel 95
        Dim iCount&    
        For iCount = 1 To Len(Source)
            TextReverse3 = Mid$(Source, iCount, 1) & TextReverse3
        Next
    End Function
    Примечание : На самом деле, список подобных функций можно продолжить, например, можно программно вызвать уже упомянутую функцию листа =ВЫЗВАТЬ() Причём, несмотря на то, что по заверениям разработчиков, вызов этой функции был полностью заблокирован в Excel 2000, это не совсем так. В действительности, разработчики заблокировали вызов этой функции только из ячеек рабочего листа, а вот программно осуществить её вызов всё-таки можно.
    MsgBox ExecuteExcel4Macro("CALL(""Msvcrt40"",""_strrev"",""1F"",""абырвалГ"")")
    
    Впрочем, в этом финте нет особой необходимости, т.к. начиная с Microsoft Excel 2000, для того, чтобы перевернуть текст, достаточно использовать всего одну VB(A) функцию StrReverse :
    Public Function TextReverse4$(Source$) 'Microsoft Excel 2000
        TextReverse4 = StrReverse(Source)
    End Function

  • Ответ :

    Для того, чтобы определить содержит ли строка буквы русского или английского алфавита, причём без перебора символов в строке, достаточно использовать оператор Like
  • iText$ = "Оператор Like используется для сравнения двух строковых выражений"
    
    If iText$ Like "*[А-я]*" Then
       MsgBox "В строке точно есть буквы из русского алфавита"
    Else
       MsgBox "В строке нет ничего интересного"
    End If
    
    If iText$ Like "*[A-z]*" Then
       MsgBox "В строке точно есть буквы из английского алфавита"
    Else
       MsgBox "В строке нет ничего интересного"
    End If

  • Ответ :

    Для того, чтобы определить содержит ли строка любую из цифр от 0 до 9, причём без перебора символов в строке, достаточно использовать оператор Like, т.е. любой из двух нижеприведённых вариантов
  • iText$ = "Оператор Like используется для сравнения 2-x строковых выражений"
    
    If iText$ Like "*[0-9]*" Then
       MsgBox "В строке точно наличествует цифра"
    Else
       MsgBox "В строке нет ничего интересного"
    End If
    iText$ = "Оператор Like используется для сравнения 2-x строковых выражений"
    
    If iText$ Like "*#*" Then
       MsgBox "В строке точно наличествует цифра"
    Else
       MsgBox "В строке нет ничего интересного"
    End If
    Комментарий : Первый пример можно также использовать для поиска определённых цифр, например, в диапазоне от 2 до 5, для этого достаточно заменить 0-9 на 2-5 ' "*[2-5]*"
  • Ответ :

    Для того, чтобы определить является ли строка адресом или именем ячейки/диапазона, достаточно использовать любой из трёх вариантов
  • Function IsAddress(iAddress$) As Boolean
        IsAddress = IsObject(Evaluate(iAddress$))
    End Function
    Комментарий : При использовании этого способа необходимо иметь ввиду, что эта функция возвратит True(Истина), если в активном рабочем листе будет находиться, например, ActiveX элемент управления с именем CommandButton1 и Вы решите проверить строку "CommandButton1"

    Если же такой расклад Вас не устраивает, то следующие варианты, лишены таких недостатков, ибо там явно проверяется тип переменной.
    Function IsAddress(iAddress$) As Boolean
        IsAddress = TypeOf Evaluate(iAddress$) Is Range
    End Function
    Function IsAddress(iAddress$) As Boolean
        IsAddress = TypeName(Evaluate(iAddress$)) = "Range"
    End Function
    Пример вызова любой из вышеопубликованных авторских функций :
    Private Sub Test()
        MsgBox IsAddress("A1")
        MsgBox IsAddress("A1:C10")
        MsgBox IsAddress("Имя_ячейки")
        MsgBox IsAddress("CommandButton1")
    End Sub

  • Ответ : Посмотреть скриншот
  • Dim iMassiv As Variant, iNewMassiv As Variant
    
    iMassiv = Range("A1:A10").Value
    iNewMassiv = Application.Transpose(iMassiv)
    Если нет необходимости в использовании первой переменной, содержащей массив значений указанного диапазона, то транспонировать массив можно напрямую :
    iMassiv = Application.Transpose(Range("A1:A10").Value)
    
    iMassiv = [Transpose(A1:A10)]

  • Ответ : Актуально только для MS Excel 2000, XP
  • iFamily = Array("Иванов", "Петров", "Сидоров")
    
    MsgBox Join(iFamily, vbLf), , ""
    Dim iFamily$(1 To 3) 'iFamily(1 To 3) As String
    
    iFamily(1) = "Иванов"
    iFamily(2) = "Петров"
    iFamily(3) = "Сидоров"
    
    MsgBox Join(iFamily, vbCr), , ""
    Если же речь идёт о данных столбца многомерного массива, то в таком случае можно об'единить вышеприведённый пример со следующими [FAQ193], [FAQ273], т.е. :
    Dim iMassiv(1 To 10, 1 To 5) 
    
    'Здесь идёт заполнение массива некими данными 
    
    MsgBox Join(Application.Transpose( _
    Application.Index(iMassiv, 0, 1)), vbNewLine), , "Первый столбец :" 
    
    'или так 
    
    With Application 
         MsgBox Join(.Transpose(.Index(iMassiv, 0, 3)), _ 
         Chr(10)), , "Третий столбец :" 
    End With 
    
    With WorksheetFunction 
         MsgBox Join(.Transpose(.Index(iMassiv, 0, 5)), _ 
         Chr(13)), , "Пятый столбец :" 
    End With
    Почти тоже самое, но применительно к данным ячейкам активного рабочего листа, может выглядить так :
    MsgBox Join(Application.Transpose(Range("A1:A10").Value), vbLf)
    
    MsgBox Join([Transpose(A1:A10)], vbCr)

  • Ответ : Скачать пример
  • Private Sub GetColumn() 
        Dim iMassiv#(1 To 100, 1 To 5) 
        Dim iColumn%, iRow%, iChooseColumn 
    
        For iColumn = 1 To 5 
            For iRow = 1 To 100 
                iMassiv(iRow, iColumn) = Rnd * 1000 
            Next 
        Next 
    
        iChooseColumn = Application.Index(iMassiv, 0, 3) 
    End Sub
    Примечание : Столбец с номером 3 используется только в качестве примера.
  • Ответ : Скачать пример
  • Private Sub GetCalculate() 
        Dim iMassiv#(1 To 100), iCount% 
        Dim iAverage#, iMin#, iMax#, iSum#, iProduct 
    
        For iCount = 1 To 100 
            iMassiv(iCount) = Rnd * 1000 
        Next 
    
        With Application 
             iAverage = .Average(iMassiv) 
             iMin = .Min(iMassiv) 
             iMax = .Max(iMassiv) 
             iSum = .Sum(iMassiv) 
             iProduct = .Product(iMassiv) 
        End With 
    End Sub

  • Ответ : Скачать пример
  • Private Sub GetCalculate2() 
        Dim iMassiv1#(1 To 100), iMassiv2#(1 To 100) 
        Dim iCount%, iSum# 
    
        For iCount = 1 To 100 
            iMassiv1(iCount) = Rnd * 1000 
            iMassiv2(iCount) = Rnd * 1000 
        Next 
    
        iSum = Application.Sum(iMassiv1, iMassiv2) 
    End Sub
    Комментарий :
  • Количество суммируемых массивов не должно превышать 30
  • Допускается суммирование как одномерных, так и двухмерных массивов
  • Массивы могут иметь различную размерность
  • Private Sub GetCalculate3() 
        Dim iMassiv#(1 To 100, 1 To 5), iSum#, iColumn%, iRow% 
    
        For iColumn = 1 To 5 
            For iRow = 1 To 100 
                iMassiv(iRow, iColumn) = Rnd * 1000 
            Next 
        Next 
    
        With Application 
             iSum = .Sum( _ 
             .Index(iMassiv, 0, 2), .Index(iMassiv, 0, 4)) 
        End With 
    End Sub
    Примечание : Столбцы с номерами 2 и 4 используются только в качестве примера.
  • Ответ : Скачать пример
  • Private Sub GetCalculate4() 
        Dim iMassiv1#(1 To 100), iMassiv2#(1 To 100) 
        Dim iCount%, iSumProduct# 
    
        For iCount = 1 To 100 
            iMassiv1(iCount) = Rnd * 1000 
            iMassiv2(iCount) = Rnd * 1000 
        Next 
    
        iSumProduct = Application.SumProduct(iMassiv1, iMassiv2) 
    End Sub
    Private Sub GetCalculate5() 
        Dim iMassiv#(1 To 100, 1 To 5), iSumProduct# 
        Dim iColumn%, iRow% 
    
        For iColumn = 1 To 5 
            For iRow = 1 To 100 
                iMassiv(iRow, iColumn) = Rnd * 1000 
            Next 
        Next 
    
        With Application 
             iSumProduct = .SumProduct( _ 
             .Index(iMassiv, 0, 1), .Index(iMassiv, 0, 5)) 
        End With 
    End Sub
    Примечание : Столбцы с номерами 1 и 5 используются только в качестве примера.
  • Ответ :

    Для того, чтобы получить одномерный массив, состоящий из значений диагонали определённого диапазона Посмотреть скриншот причём без цикла, можно использовать нижеопубликованный макрос.
  • Private Sub getArrayOfDiagonalRange()
        Dim iMassiv As Variant
        iMassiv = Application.Index([A1:E3], Array(1, 2, 3), Array(1, 2, 3))
    End Sub
    Комментарий : Обратите внимание на то, что данный способ не ограничивается только диагональю Посмотреть скриншот, поэтому можно изменить номера строк/столбцов на те, что необходимы в решении Вашей конкретной задачи.
    Private Sub getArrayOfDiagonalRange2()
        Dim iMassiv As Variant
        iMassiv = Application.Index([A1:E3], Array(1, 2, 3, 2, 1), Array(1, 2, 3, 4, 5))
    End Sub

  • Ответ :

    Для того, чтобы получить случайное целое число в заданном диапазоне, достаточно использовать нижеприведённую инструкцию, где ВерхняяГраница это максимальное число нужного диапазона, а НижняяГраница это минимальное число этого же диапазона.
  • iRnd = Int((ВерхняяГраница - НижняяГраница + 1) * Rnd + НижняяГраница)
    
    Источник : Справка Microsoft Office
  • Ответ : Скачать пример

    Для того, чтобы получить массив, содержащий случайные, но неповторяющиеся числа, можно использовать нижеприведённую процедуру. Обратите внимание на то, что в данном примере генерируются целые числа от Min = 1 до Max = 1000, а количество элементов массива = 100
  • Private Sub GetArrayUniqueRandom() 
        Dim iRndUnique(1 To 100) As Long 
        Dim iCount As Long, iRnd As Long 
        For iCount = 1 To 100 'UBound(iRndUnique) 
            Do 
                 iRnd = Int(Rnd * 1000) + 1 
            Loop While IsNumeric(Application.Match(iRnd, iRndUnique, 0)) 
            iRndUnique(iCount) = iRnd 
        Next 
    End Sub

  • Ответ :

    Если в процессе работы Вам приходится защищать лист, книгу и Вы не хотите использовать один и тот же пароль, то Вы можете генерировать пароль программно, используя нижеопубликованную функцию, которая имеет всего один аргумент, а именно количество символов в пароле.
  • Private Function ChildPassword$(LenPassword%) 
        Randomize 'Timer 
        ChildPassword = Space(LenPassword) 
        For iCount% = 1 To LenPassword 
            Mid(ChildPassword, iCount%, 1) = Chr(Rnd * 255) 'Chr(Int(Rnd * 256)) 
        Next 
    End Function
    Примеры использования :
    MsgBox ChildPassword(25)
    
    Лист1.Protect Password:=ChildPassword(25)
    
    ActiveSheet.Protect Password:=ChildPassword(25)
    
    Worksheets(1).Protect Password:=ChildPassword(25)
    
    Worksheets("Лист1").Protect Password:=ChildPassword(25)
    Совет : Не забывайте, что установка защиты не гарантирует сохранность всех конфиденциальных данных.
  • Ответ :

    Если при работе с коллекцией, Вам необходимо удалить все элементы, то это можно осуществить одной строкой и без цикла, т.е.
  • Set iCollection = Nothing
    Если же Вы почему-то уверены, что цикл необходим, то ниже опубликованы два варианта, также позволяющие очистить коллекцию

    Вариант I. (без использования переменной)
    Do Until iCollection.Count = 0
       iCollection.Remove 1
    Loop
    Do While iCollection.Count > 0
       iCollection.Remove 1
    Loop
    Вариант II. (с применением переменной)
    For iCount = iCollection.Count To 1 Step -1
        iCollection.Remove iCount
    Next
    For iCount = 1 To iCollection.Count
        iCollection.Remove 1
    Next
    Дополнение : пример заполнения коллекции, перебор всех её элементов (два варианта), а также их удаление (без цикла), можно найти в этом модуле
  • Ответ :

    Если, при работе с логической переменной (тип Boolean), Вам понадобится изменить её значение на противоположное, т.е. сменить True на False или наоборот, то это можно осуществить без дополнительных проверок
  • iVar = Not iVar
    Обратите внимание на то, что используя подобный подход, можно менять и значения некоторых свойств, например, нижеопубликованный код позволит сменить состояние "флажка" CheckBox1 на противоположное.
    CheckBox1.Value = Not CheckBox1.Value 'CheckBox1 = Not CheckBox1

  • Ответ :
  • iWeekDay = WeekDay(Now, vbMonday)
    
    iDate = #9/8/2004# ' "08.09.04"
    iWeekDay = WeekDay(iDate, vbMonday)

  • Ответ :
  • iDateOne = #9/8/2004# ' "08.09.04"
    iDateTwo = #10/8/2004# ' "08.10.04"
    
    iCountOfDays = iDateTwo - iDateOne ' Вариант I.
    
    iDateOne = #9/8/2004# ' "08.09.04" iDateTwo = #10/8/2004# ' "08.10.04" iCountOfDays = DateDiff("d", iDateOne, iDateTwo) ' Вариант II.

  • Ответ :

    Если Вы являетесь обладателем руссифицированной системы, то конвертировать текст, содержащий название месяца, причём именно на русском, непосредственно в дату, довольно просто, ибо для этого есть несколько VB(A) функций
  • Dim iText$
    iText = "03 Января 2007" '"3 Январь 2007" '"3 Янв 7"
    
    MsgBox CDate(iText)
    MsgBox DateValue(iText)
    MsgBox Format(iText, "dd/mm/yyyy") 'это также текст
    
    Комментарий : Если кроме даты текст содержит ещё и время, то первая функция возвратит ещё и его, а вторая, отбросит. Кроме того, не стоит забывать, что третья функция возвращает текст, поэтому, если после конвертации, полученные данные должны участвовать в вычислениях, то лучше использовать первые два варианта, а если результат планируется , например, выводить в Label или об'единять с другим текстом, то Format вполне может Вам пригодиться.

    Сложнее будет, если название месяца будет указано на английском. Впрочем, в Microsoft Excel для такой конвертации, можно использовать стандартную функцию рабочего листа =ДАТАЗНАЧ(), которая, как и её VB(A) тёзка, также отбрасывает время.
    Dim iText$, iDate As Date
    iText = "03 June 2004" '"3 June 2004" '"3 Jun 4"
    iDate = Evaluate("DateValue(""" & iText & """)")
    'iDate = ExecuteExcel4Macro("DateValue(""" & iText & """)")
    
    MsgBox iDate

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff