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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 81 След.
UDF для конвертации персидской даты в григорианскую
 
Если нужна скорость, то кеш:
Код
Function GetMonth(ByVal strDate As String) As Integer
    Dim i As Integer
    Static arr(1 To 12) As String
    If arr(1) = "" Then
        For i = 1 To 12
            arr(1 + (i + 8) Mod 12) = WorksheetFunction.Text(DateSerial(1900, i, 1), "[$-160429]mmmm")
        Next i
    End If
  
    For i = 1 To 12
        If StrComp(strDate, arr(i), vbTextCompare) = 0 Then
            GetMonth = i
            Exit For
        End If
    Next i
End Function
Изменено: sokol92 - 1 Апр 2020 15:01:02
Владимир
О равенстве значений ячеек
 
come on!
Владимир
О равенстве значений ячеек
 
Задачки для первого класса.

1. Рефлексивность равенства

Всегда ли значением формулы

=A1=A1

будет ИСТИНА (TRUE)?

2. Симметричность равенства.

Всегда ли формулы

=A1=B1
и
=B1=A1

выдают одинаковые результаты?

3. Транзитивность равенства

Может ли формула
=ЕСЛИ(И(B1=A1; C1=A1); B1=C1; ИСТИНА)

выдавать ЛОЖЬ (FALSE)?

О терминологии - здесь.

Может быть, кому-нибудь задачи покажутся интересными. Просьба решения сегодня публиковать под спойлерами.
Изменено: sokol92 - 1 Апр 2020 13:55:02
Владимир
UDF для конвертации персидской даты в григорианскую
 
Сейчас подкину пару задач. :)  
Изменено: sokol92 - 1 Апр 2020 13:57:04
Владимир
Извлечь фрагмент между третьей и четвертой запятой
 
Проще файл из #3 открыть в Excel с учетом того, что запятая является разделителем полей.
Владимир
Использование функции из надстройки PLEX в коде
 
Добрый день! Необходимо приложить файл-пример к сообщению #1.
Владимир
UDF для конвертации персидской даты в григорианскую
 
Добрый день! Михаил, литералы в VBA не должны содержать нерелевантные символы.

Проще всего вернуться к лобовому варианту:
Код
Function GetMonth(ByVal strDate As String) As Integer
Static arr
If Not IsArray(arr) Then
  arr = Range("d_months")
End If
For i = 1 To 12
    If StrComp(strDate, arr(i, 1), vbTextCompare) = 0 Then
        GetMonth = i
        Exit For
    End If
Next i
End Function

d_months - именованный диапазон для названий месяцев F2:F13. И работать будет для всех версий.
Изменено: sokol92 - 1 Апр 2020 13:25:16
Владимир
UDF для конвертации персидской даты в григорианскую
 
Здравствуйте, Игорь! Функция GetMonth выдает 0, поскольку Ваша версия Excel еще не знает персидского календаря (проверил у себя на Excel 2007).
Можно номер месяца (1-12) определить по списку, который есть на листе книги из #1.
Владимир
Добавить комментарии в свою надстройку
 
Так в файле надстройки (это же архив) и посмотрите. Файл в архиве - \customUI\customUI.xml
Владимир
UDF для конвертации персидской даты в григорианскую
 
Успехов!
Владимир
UDF для конвертации персидской даты в григорианскую
 
Можно также написать отдельную функцию для проверки:

Код
Function IsPersianDate(ByVal s As String) As Boolean
  Dim d
  On Error Resume Next
  d = Gdate(s)
  On Error GoTo 0
  IsPersianDate = Not IsEmpty(d)
End Function
Изменено: sokol92 - 31 Мар 2020 16:58:50
Владимир
UDF для конвертации персидской даты в григорианскую
 
Функция из #10 анализирует первые три слова ячейки и интерпретирует их как число месяца, название месяца на фарси и номер года. Цифры при этом могут быть записаны привычными нам символами или "родными" арабскими (они же персидские) символами.
Если значение ячейки не соответствует этим правилам, то UDF-функция Gdate вернет значение #ЗНАЧ!
Изменено: sokol92 - 31 Мар 2020 18:00:16
Владимир
Проблемы с получением числовых значений из TextBox
 
Этот эффект обсуждался здесь.
Владимир
UDF для конвертации персидской даты в григорианскую
 
Добрый день, Михаил! Интересно, что Excel 2016 лихо умеет переводить персидские даты в григорианские. Выбираешь в формате ячейки "Дата", "Персидский", Тип календаря "Персидский", "Вставлять даты согласно выбраннному календарю", набиваешь 05.09.1398 и получаешь 26.11.2019 (что видно, если вернуть обычный формат даты).
Изменено: sokol92 - 31 Мар 2020 16:32:07
Владимир
UDF для конвертации персидской даты в григорианскую
 
Воспользуемся в лучших традициях плодами чужого труда: :)
Код
Function Gdate(ByVal cell)
  Dim arr, d As Long, m As Long, y As Long
  arr = Split(cell)
  d = ToDbl(arr(0))
  m = GetMonth(arr(1))
  y = ToDbl(arr(2))
  Gdate = toGregorianDateObject(y, m, d)
End Function

Private Function ToDbl(ByVal s)
  ToDbl = Application.Evaluate("--" & s)
End Function

Function GetMonth(ByVal strDate As String) As Integer
For i = 1 To 12
    If InStr(strDate, WorksheetFunction.Text(i * 28, "[$-160429]mmmm")) <> 0 Then
        GetMonth = 1 + ((i + 8) Mod 12)
    Exit For
    End If
Next
End Function
Изменено: sokol92 - 31 Мар 2020 16:22:59
Владимир
Перевод формата даты Google Analytics в краткий формат даты Excel
 
Цитата
БМВ написал:
Владимир начнет про регионалки вещать
Вещание на карантине. :)  
Владимир
Перевод формата даты Google Analytics в краткий формат даты Excel
 
Можно так:
Код
=ДАТА(ПСТР(A2;1;4);ПСТР(A2; 5;2);ПСТР(A2;7;2))
Владимир
Как узнать высоту окна листа, в которой видны ячейки?
 
За указанную в #1 область отвечает диапазон ActiveWindow.VisibleRange, при этом часть его последней строки может быть невидимой. Можно поиграться с предпоследней строкой, пытаясь увеличить ее высоту:
Код
Option Explicit
Function GetVisibleRangeHeight()
 Dim r As Range, n As Long, i As Long, h_old As Double, h As Double, row As Range
 With ActiveWindow
   Set r = .VisibleRange
   n = r.Rows.Count
   Set r = r.Resize(n - 1)       ' отбросили последнюю строку, которая может быть видна не полностью
   Set row = Rows(r.row + n - 2) ' последняя строка r
   h_old = row.RowHeight         ' и ее высота
   h = h_old
   Do While True
     h = h + 0.25
     row.RowHeight = h
     If .VisibleRange.Rows.Count <> n Then
       Exit Do
     End If
   Loop
   row.RowHeight = h - 0.25      ' вернули предыдущую высоту
   
   GetVisibleRangeHeight = r.Height
   row.RowHeight = h_old
  End With
End Function
Изменено: sokol92 - 30 Мар 2020 18:52:53
Владимир
Ошибка 1004 при сравении данных из ячейки и textbox'а
 
Добрый день. В VBA с неявным преобразованием типов далеко не все очевидно. Если определить ValTB в #8 как "String", то всё неожиданно заработает.
Разумеется, лучше использовать явные преобразования:
Код
Sub test1()
  Dim valTB
  valTB = UserForm1.TextBox1.Value
  If IsNumeric(valTB) Then
    valTB = CDbl(valTB) ' преобразовали в Double
  Else  ' в Textbox введено не число
    ' ...
  End If
End Sub
Изменено: sokol92 - 30 Мар 2020 17:37:58
Владимир
HB
 
Алексей, с удовольствием присоединяюсь к коллегам! Успехов во всех областях!
Владимир
Удалить в диспетчере имен некорректные имена кодом VBA, имена содержащие ошибку #ИМЯ?
 
Здравствуйте, Андрей! Ругается от бессильной злобы :)  
Таких имен обычно совсем немного и их можно потом грохнуть в ручном режиме.
Относительно файла из #1 - "плохое" имя исчезает, если пересохранить в .xlsm (все версии Excel, начиная с 2007).
Изменено: sokol92 - 27 Мар 2020 17:03:24
Владимир
Удалить в диспетчере имен некорректные имена кодом VBA, имена содержащие ошибку #ИМЯ?
 
Здравствуйте, Виталий!
Мы используем для удаления имен макрос примерно в такой редакции (для систем с кодовой страницей Windows-1251 :)   )

Код
Sub DeleteErrorName()
    Dim n As Name
    Dim count As Integer
    If MsgBox("Удалить в книге все имена с ошибочными значениями? (без возможности востановления)", vbQuestion + vbYesNo) = vbYes Then
        On Error Resume Next
        For Each n In ActiveWorkbook.Names
            If n.Value Like "=[#]*" Then
                n.Delete
                If Err = 0 Then
                    count = count + 1
                Else
                    MsgBox "Ошибка при удалении имени " & n.Name
                    Err.Clear
                End If
            End If
        Next n
        MsgBox "Удалено имён - " & count
    End If
End Sub

Диалог "Диспетчер имен" умеет делать вещи, недоступные нам, простым макрописателям. А макрорекордер этого не понимает...

Чуть-чуть поэкспериментировал с файлом в Excel 2016. Если этот файл сохранить в формате .xlsm, закрыть и вновь открыть, то "плохое" имя исчезает.
Изменено: sokol92 - 27 Мар 2020 16:36:02
Владимир
Ограничить тип символов, которые могут идти после искомого значения, которое используется как подстрока
 
Можно в таком стиле: для разделителей пробел и запятая (легко дополняется):
Код
=НЕ(И(ЕОШИБКА(ПОИСК("*"&A1&" *";B1&" "));ЕОШИБКА(ПОИСК("*"&A1&",*";B1&","))))

Сейчас придут формулисты и переделают коротко и непонятно. :D  
Владимир
Разделить любое число на 5 целых чисел
 
Добрый день! Чтобы не накапливалась погрешность, в таких случаях обычно применяют скользящее округление (для файла Виктора из #6):
Код
=ОКРУГЛ($B3/5*СТОЛБЕЦ(A3);0)-СУММ($C3:C3)
Владимир
Как заменить формулу в Гугл таблице на значение этой формулы автоматически?
 
Михаил Л, мы, вероятно, пишем о разных вещах. Мое сообщение #14 относится к действиям, которые производятся уже в Microsoft Excel после открытия скачанного файла, содержащего "странные" формулы. Это ответ на вопрос автора темы:
Цитата
и я вот не знаю как сделать что бы после скачивания отображались значения а не формулы
В ваших сообщениях, по-видимому, описываются действия для Google Таблиц.
Изменено: sokol92 - 26 Мар 2020 21:24:09
Владимир
SendInput не работает в x64
 
Можно попробовать так:

Код
#If Win64 Then
Type GENERALINPUT: dwType As LongPtr: xi(0 To 31) As Byte: End Type
#Else
Type GENERALINPUT: dwType As LongPtr: xi(0 To 23) As Byte: End Type
#End If
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As LongPtr, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Изменено: sokol92 - 26 Мар 2020 14:39:52
Владимир
SendInput не работает в x64
 
Код
Sub test()
  AppActivate "Блокнот"
  With CreateObject("WScript.Shell")
    .SendKeys "HELLO"
  End With
End Sub
Владимир
Как заменить формулу в Гугл таблице на значение этой формулы автоматически?
 
Файл из #6, отображенный во второй части сообщения, легко лечится через специальную вставку значений.
CTRL+A, CTRL+Ins, правая кнопка мыши, Специальная вставка/Значения/OK.
Владимир
Обновление данных, получаемых из СУБД, без указания пользователем Excel логина и пароля к базе, настроить подключение к SQL Server
 
Тема: Обновление данных, получаемых из СУБД, без указания пользователем Excel логина и пароля к базе
Владимир
Дублирование данных при объединении запросов в Power Query
 
Любая задолженность может погашаться частями (2 и более раз). В выписке банка обязательно должен быть (и всегда есть) реквизит "Сумма".
Изменено: sokol92 - 25 Мар 2020 19:15:19
Владимир
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 81 След.
Наверх