Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 100 След.
Макрос, на изменения названия книги
 
Здесь нет отчества - двойное имя. Для выделения (традиционных) отчеств в русском языке можно использовать шаблоны для оператора Like:
  • "*[викмь]ич"
  • "*[илыч]"
  • "[вч]на"
В отчествах тюркского происхождения могут использоваться для женских:
  • гызы
  • кызы
  • кыс
для мужских
  • оглы
  • оглу
  • оол
Изменено: sokol92 - 28 сен 2020 14:44:59
Владимир
Макрос, на изменения названия книги
 
Цитата
Юрий М написал:
Всегда найдётся фамилия, имя, отчество, по которым невозможно определить пол )
По отчеству пол определяется практически всегда. Другое дело, что не у всех есть отчество - тогда приходится ориентироваться на словарь имен. Для сочетаний, подобных "Мишель Легран", эта задача не решается.
Владимир
Дополнить макрос преобразования из кириллицы в латиницу
 
Версия 2.
Код
Function KzCyrToLat(ByVal s As String) As String
    Static cyr, lat, Dict As Object
    Dim i As Long, s1 As String, s2 As String, arr() As String, arr2() As Long, b As Boolean, n As Long
    If IsEmpty(cyr) Then
        ' буквы казахского алфавита
        cyr = Array(1072, 1073, 1074, 1075, 1076, 1077, 1105, 1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1241, 1110, 1187, 1171, 1199, 1201, 1179, 1257, 1211)
        lat = Array("a", "b", "v", "g", "d", "e", "yo", "zh", "z", "i", "y", "k", _
            "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
            "sh", "sch", "", "y", "", "e", "yu", "ya", "a", "i", "ng", "g", "u", "u", "k", "o", "h")
        If UBound(cyr) <> UBound(lat) Then
            MsgBox "Dimensions of arrays cyr and lat must be the same", vbCritical
            Exit Function
        End If
     
        Set Dict = CreateObject("Scripting.Dictionary")
        For i = 0 To UBound(cyr)
            Dict(ChrW(cyr(i))) = lat(i)
            Dict(UCase(ChrW(cyr(i)))) = StrConv(lat(i), vbProperCase)
        Next i
    End If  ' первоначального заполнения
         
    n = Len(s)
    ReDim arr(1 To n)
    ReDim arr2(1 To n)
    
    For i = 1 To Len(s)
        s1 = Mid(s, i, 1)
        If Dict.exists(s1) Then
            arr(i) = Dict(s1)
            arr2(i) = 1  ' признак трансляции символов
        Else
            arr(i) = s1
        End If
    Next i
         
    ' Обработка "особых" правил
    For i = 1 To n
        If arr2(i) = 1 Then
            s1 = arr(i)
            If LCase(s1) = "e" Then  ' добавляем y к е
                If i = 1 Then
                    b = True
                Else
                    b = LCase(arr(i - 1)) Like "[aouiye]"
                End If
                If b Then arr(i) = IIf(s1 = "e", "ye", "Ye")
         
            ElseIf LCase(s1) = "y" And i > 1 And i < n Then
                arr(i) = IIf(arr(i) = "y", "i", "I")
         
            ElseIf LCase(s1) = "s" And i > 1 And i < n Then
                If LCase(arr(i - 1)) Like "[aouiye]" And LCase(arr(i + 1)) Like "[aouiye]" Then arr(i) = IIf(arr(i) = "s", "ss", "Ss")
            End If
        End If
    Next i
    KzCyrToLat = Join(arr, "")
End Function
Владимир
как открыть файл с расширением хlsm, в офисе 2013-2016
 
Может быть, и так. Или баг в старой версии LO Calc (4.4.3.2 от мая 2015 года).
Изменено: sokol92 - 28 сен 2020 13:04:00
Владимир
как открыть файл с расширением хlsm, в офисе 2013-2016
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
был сохранен не в 365 офисе, а в LibreOffice.
В текущих версиях LibreOffice этот эффект не воспроизводится.
Владимир
Дата в функции суммеслимн с помощью &
 
У меня (Excel 2016 32-) время практически одинаково.

Код
Option Explicit
Sub test()
  Dim t As Double, i As Long, arr
  Const nRows As Long = 10000
  Application.ScreenUpdating = False
  ReDim arr(1 To nRows, 1 To 2)
  For i = 1 To nRows
    arr(i, 2) = i Mod 2
    arr(i, 1) = 1
  Next i
  Range("B1:C" & nRows) = arr
  
  Application.Calculation = xlCalculationManual
  Range("A1:A" & nRows).Formula = "=SumIfs(B:B, C:C, C1)"
  t = Timer
  Application.Calculation = xlCalculationAutomatic
  Debug.Print "Весь столбец", Timer - t
 
  Application.Calculation = xlCalculationManual
  Range("A1:A" & nRows).Formula = "=SumIfs($B$1:$B$" & nRows & ", $C$1:$C$" & nRows & ", C1)"
  t = Timer
  Application.Calculation = xlCalculationAutomatic
  Debug.Print "С ограничением по числу строк", Timer - t
 
  Application.ScreenUpdating = True
End Sub

Кроме #6 разработчик об этом пишет и в других местах. У меня нет оснований не верить этим высказываниям.
Изменено: sokol92 - 27 сен 2020 16:38:14
Владимир
Дата в функции суммеслимн с помощью &
 
Успехов!
Владимир
Получение даты из значения в заданной ячейке.
 
У гроссмейстера не выиграешь. :(  
Владимир
Получение даты из значения в заданной ячейке.
 
Цитата
БМВ написал:
или чуть короче
В #8 можно вместо "1-1-202" записать "1-202".  :)  
Владимир
Дополнить макрос преобразования из кириллицы в латиницу
 
Проверяйте. Функция должна работать с любыми кодовыми страницами Windows и с любыми региональными настройками.
Код
Option Explicit
Function KzCyrToLat(ByVal s As String) As String
    Static cyr, lat, Dict As Object
    Dim i As Long, s1 As String, s2 As String, arr() As String, b As Boolean, n As Long
    If IsEmpty(cyr) Then
        ' буквы казахского алфавита
        cyr = Array(1072, 1073, 1074, 1075, 1076, 1077, 1105, 1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1241, 1110, 1187, 1171, 1199, 1201, 1179, 1257, 1211)
        lat = Array("a", "b", "v", "g", "d", "e", "yo", "zh", "z", "i", "y", "k", _
            "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
            "sh", "sch", "", "y", "", "e", "yu", "ya", "a", "i", "ng", "g", "u", "u", "k", "o", "h")
        If UBound(cyr) <> UBound(lat) Then
            MsgBox "Dimensions of arrays cyr and lat must be the same", vbCritical
            Exit Function
        End If
    
        Set Dict = CreateObject("Scripting.Dictionary")
        For i = 0 To UBound(cyr)
            Dict(ChrW(cyr(i))) = lat(i)
            Dict(UCase(ChrW(cyr(i)))) = StrConv(lat(i), vbProperCase)
        Next i
    End If  ' первоначального заполнения
        
    ReDim arr(1 To Len(s))
    For i = 1 To Len(s)
      s1 = Mid(s, i, 1)
      If Dict.exists(s1) Then
        arr(i) = Dict(s1)
      Else
        arr(i) = s1
      End If
    Next i
        
    ' Обработка "особых" правил
    n = UBound(arr)
    For i = 1 To n
      s1 = arr(i)
      If LCase(s1) = "e" Then  ' добавляем y к е
        If i = 1 Then
          b = True
        Else
          b = LCase(arr(i - 1)) Like "[aouiye]"
        End If
        If b Then arr(i) = IIf(s1 = "e", "ye", "Ye")
        
      ElseIf LCase(s1) = "y" And i > 1 And i < n Then
         arr(i) = IIf(arr(i) = "y", "i", "I")
        
      ElseIf LCase(s1) = "s" And i > 1 And i < n Then
        If LCase(arr(i - 1)) Like "[aouiye]" And LCase(arr(i + 1)) Like "[aouiye]" Then arr(i) = IIf(arr(i) = "s", "ss", "Ss")
      End If
    Next i

    KzCyrToLat = Join(arr, "")
End Function
Владимир
О сравнении текста и числа в VBA
 
WorksheetFunction.CountIf ведет себя так же, как и функция СЧЁТЕСЛИ (за исключением моментов, связанных с локализаций). Второй параметр ">0" для этой функции определяет подсчет в заданном диапазоне ячеек с числовым значением, большим нуля. При этом пустые ячейки, ячейки содержащие текст, логические или ошибочные значения при "числовом" подсчете игнорируются.
Владимир
Как обновить макрос, чтобы работал на 64-bit
 
Поскольку в теме есть неточности, давайте разберем этот пример. Цель: составить определение функции из сообщения #3 для версий офиса 2010+ (VBA7).
1. Ищем описание функции в файле Win32API_PtrSafe.TXT. К сожалению, этой функции там нет.
2. Ищем описание это функции в документации разработчика. Находим здесь.
3. Анализируем типы параметров и возвращаемое значение функции. Описание типов, используемых Microsoft в документации, можно найти здесь (в дальнейшем - Типы). Итак:
  • параметр Hwnd типа HWND. Согласно Типам, HWND - это HANDLE, а HANDLE - указатель. Для указателей в VBA7 используется LongPtr.
  • параметр crKey типа COLORREF. Согласно Типам это 32-разрядное целое, в VBA  - Long
  • параметр bAlpha типа BYTE. Согласно Типам 1-байтовое целое, в VBA - Byte
  • параметр dwFlags типа DWORD. Согласно Типам 32-разрядное целое, в VBA - Long (практически все параметры с префиксом "dw" имеют тип Long)
  • возвращаемое значение описано как BOOL, согласно типам это int - 32-разрядное целое, в VBA - Long

Теперь составляем описание:
Код
#If VBA7 Then  ' версии MS Officе, начиная с 2010
  Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As LongPtr, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#Else
  Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#End If

Если мы все-таки ошиблись в описании какой-либо функции, то выполнение Excel с большой долей вероятности завершится аварийно. Поэтому перед выполнением сохраняем все данные.
Изменено: sokol92 - 26 сен 2020 15:39:34
Владимир
О сравнении текста и числа в VBA
 
В теме сопоставляются разные вещи.

1. Сравнение в VBA переменной типа Variant c числом в случае, если переменная содержит текст.
VBA в этом случае перед сравнением пытается преобразовать текст в число. Если это невозможно, то считается что текст больше (как и в формулах Excel).
Код
Sub test()
  Dim v As Variant
  v = ""
  Debug.Print v > 9999
End Sub

Выдает True.

Если в примере тип переменной v описать как String, то возникнет ошибка преобразования типа.

2. Алгоритм работы функции рабочего листа CountIf.

Для модераторов тема: о сравнении текста и числа в VBA
Изменено: sokol92 - 26 сен 2020 14:13:10
Владимир
Перевод на русский язык терминов, используемых в описании работы динамических массивов
 
Хорошее объяснение этих терминов здесь.
Владимир
Как определить версию Excel, которой был сохранен файл
 
Не у всех, как у медвеля, есть сотни машин. Обычные пользователи готовят примеры для форума на том же (единственном?) экземпляре Excel, на котором и будут в дальнейшем работать.  :)  
Владимир
Формат подписи данных диаграммы. Разделить значения на миллион
 
Или в "Формате оси" диаграммы поставить цену деления 1 000 000.
Владимир
Как определить версию Excel, которой был сохранен файл
 
Здравствуйте, Виталий! Быстрее посмотреть в файл, будешь дольше искать, где этот макрос. :)  
Владимир
Склеивание текста из образцов, Склейка текста из кусков, куски рандомно меняются внутри текста
 
Цитата
БМВ написал:
1. какая версия Excel
Excel 2019   :D  
Владимир
Как избавиться от предупреждения «Файл уже используется», При открытии файла - я сам обрабатываю ситуация
 
Цитата
Кирилл Найдёнов написал:
Тогда какое событие можно взять, что бы оно возникало до появления этой надписи?
Перечень событий объекта Application приведенздесь. События типа "WorkbookBeforeOpen" в нем нет.
Владимир
VBA. Удаление строк, в которых непустая ячейка в столбце
 
Добрый день! Удаление несмежных строк - долгий процесс, независимо от того, получены ли они методом Union (медленным), автофильтром или методом Range.SpecialCells.
Владимир (ZVI) еще в 2009 году (или раньше?) предложил отсортировать строки исходного диапазона по признаку удаления, а затем применить одно удаление уже смежных строк (см. #6). Даже для миллиона строк такой подход занимает секунды. В ссылке из сообщения Игоря #8 автор на stackoverflow в 2015 году "переоткрывает" этот метод.
Изменено: sokol92 - 23 сен 2020 19:28:20
Владимир
Me.TextBox3.Value="" определяется как числовое значение
 
Здравствуйте, Игорь, коллеги! Тут есть один "хитрый" момент, который заключается в том, что свойство Value объекта Textbox имеет тип Variant, в отличие от свойства Text, которое имеет тип String. Если бы в #1 использовалось свойство Text вместо Value, то возникла бы ошибка преобразования типа (проверьте!).
VBA по-разному сравнивает типы String c Integer (Long...) и Variant c Integer (Long...). В первом сравнении производится попытка преобразования текста в число, при невозможности возникает ошибка времени выполнения. Во втором случае при невозможности преобразования текста в число считается, что текст больше числа (как в языке формул Excel).

Если мы хотим гарантировать, что текст из Textbox может быть в VBA интерпретирован как число, то лучше в начале проверить свойство Value (или Text) с помощью функции IsNumeric.
Изменено: sokol92 - 23 сен 2020 16:27:45
Владимир
Хронология в Excel
 
В отписке
Владимир
Точки как граница ячеек по умолчанию. Как избавиться?
 
Файл Excelxx.xlb создается при модификации меню, ленты, панели быстрого доступа и т.д.
Если снос ветви реестра не помог, то не факт, что поможет переустановка офиса - сообщите о результате.
Изменено: sokol92 - 21 сен 2020 13:47:11
Владимир
При протягивании формулы пропал выбор "только значения" или "только формат", Вместо этого теперь мини-окно с выбором варианта условного форматирования
 
Это может быть параметр Дополнительно / Распространять форматы и формулы при расширении данных
(в начале списка дополнительных параметров)
Изменено: sokol92 - 21 сен 2020 13:11:19
Владимир
Как избавиться от предупреждения «Файл уже используется», При открытии файла - я сам обрабатываю ситуация
 
Открывайте файл макросом.

Событие Workbook.Open возникает после того, как файл открыт.
Владимир
Точки как граница ячеек по умолчанию. Как избавиться?
 
Можно попробовать пойти по сокращенному пути.
1. Удалить ветку реестра \HKEY_CURRENT_USER\Software\Microsoft\Office
2. Удалить папку (с подпапками) C:\Users\ВашеИмяl\AppData\Roaming\Microsoft\Excel (если там есть что-то нужное, то предварительно скопировать)

3. Стартовать Excel
Изменено: sokol92 - 21 сен 2020 12:13:02
Владимир
Перевести дату по-русски на дату по-английски одной формулой
 
Цитата
БМВ написал:
Хочу взглянуть в глаза тому
Кто из них ? :)  
Владимир
Перевести дату по-русски на дату по-английски одной формулой
 
Цитата
БМВ написал:
b форматирует с шагом
bbbb (или bb - 2 последние цифры) - год по тайскому календарю (интуиция Михаила не подводит).
ggge используется для года в японском календаре. Не понял, чем это отличается от григорианского года.

Полезная информация здесь.
Владимир
Какие возможные причины не "срабатывания" условного форматирования., Условное форматирование по формуле не работает.
 
Забудьте на минуту про условное форматирование. Просто отлаживайте формулу.
Владимир
Перевести дату по-русски на дату по-английски одной формулой
 
Самое смешное, что в VBA нет проблем с локализацией символов форматирования:
Код
Sub test()
  Debug.Print Application.Text(Now(), "[$-409]DDDD, MMMM DD, YYYY")
End Sub
Владимир
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 100 След.
Наверх