Решил написать в Excel небольшую программку (на vba), которая бы подсчитывала, сколько мы имеем светлого времени в зависимости от нашего режима дня. Сам был удивлен результатами: оказывается, в самое активное и полезное для человека время - после работы вечером у нас гораздо больше (и намного) темных часов, чем светлых. Треть жизни мы спим, треть жизни (в рабочие дни, а их большинство в году) мы работаем. 4 часа из оставшихся 8 часов мы тратим на сборы на работу, дорогу и обеденный перерыв. И только примерно 4 часа в рабочий день у нас имеется для досуга: занятий домашними делами, спортом, прогулками с детьми, работой на приусадебном участке и т. п. И от системы исчисления времени очень сильно зависит, при свете мы будем их проводить или в темноте. Продолжительность светового дня очень сильно различается в зависимости от времени года. И самое оптимальное использование светлого времени получается при опережении минимум на час-полтора административного времени над астрономическим (астрономический полдень, это когда тень от палки, воткнутой в землю, максимальна в 12:00). Если кому интересна эта тема, файл во вложении, из-за размеров выложил на ЯндексДиске Никаких сложных решений там нет, обычные арифметические действия со временем: " + - / * ".
Добрый вечер! Баловался с попыткой вытащить котировки цен на золото в реальном времени, может кому будет интересен результат. Автоматический запрос делать не стал, запускается кнопкой, так как практической ценности не имеет, просто делал для тренировки. Также не стал включать в результаты алюминий и всякие другие вещи, типа урана. На сайте данные обновляются каждые несколько минут. Работает через Internet Explorer, так что его наличие обязательно в системе. Иногда "задумывается" секунд на 15 при открытии страницы.
Скрытый текст
Код
Option Base 1
Dim a(12) As String
Sub ЗаполнениеТекстБоксов()
'aequit 04.03.2020
Dim i As Long
Call ПарсерКотировок
For i = 1 To 12
UserForm1.Controls("TB" & i) = a(i)
If (i = 3 Or i = 4 Or i = 9 Or i = 10) And Left(a(i), 1) = "+" Then
UserForm1.Controls("TB" & i).ForeColor = 5287936
ElseIf (i = 3 Or i = 4 Or i = 9 Or i = 10) And Left(a(i), 1) = ChrW(8722) Then
UserForm1.Controls("TB" & i).ForeColor = 255
End If
Next i
End Sub
Sub ПарсерКотировок()
'Автор: https://excelvba.ru/code/GetHTTPResponse
Dim IExp As Object, addr$, t$, i&
Set IExp = CreateObject("InternetExplorer.Application")
On Error Resume Next
addr$ = "https://www.kitco.com/mining/"
IExp.Navigate addr$
While IExp.Busy Or (IExp.ReadyState <> 4): DoEvents: Wend
t = IExp.Document.body.innerText
IExp.Quit: Set IExp = Nothing
'aequit 03.03.2020
a(1) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?Ask)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Change[\s\S]*)", 1)
a(2) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?Ask)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Change[\s\S]*)", 2)
a(3) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?Change)([-+]\d{1,6}\.\d{2})([-+])([\s\S]*?Low[\s\S]*)", 1)
a(4) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?Change)([-+]\d{1,6}\.\d{2})([-+]\d{1,6}\.\d{2}%)([\s\S]*?Low[\s\S]*)", 2)
a(5) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?High)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Silver[\s\S]*)", 1)
a(6) = RegExRepl(t, "([\s\S]*Gold[\s\S]*?High)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Silver[\s\S]*)", 2)
a(7) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?Ask)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Change[\s\S]*)", 1)
a(8) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?Ask)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Change[\s\S]*)", 2)
a(9) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?Change)([-+]\d{1,6}\.\d{2})([-+])([\s\S]*?Low[\s\S]*)", 1)
a(10) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?Change)([-+]\d{1,6}\.\d{2})([-+]\d{1,6}\.\d{2}%)([\s\S]*?Low[\s\S]*)", 2)
a(11) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?High)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Prices in[\s\S]*)", 1)
a(12) = RegExRepl(t, "([\s\S]*Silver[\s\S]*?High)(\d{1,6}\.\d{2})(\d{1,6}\.\d{2})([\s\S]*?Prices in[\s\S]*)", 2)
For i = 1 To 12
a(i) = Replace(Replace(Replace(a(i), ".", ","), "%", ChrW(8198) & "%"), "-", ChrW(8722))
Next i
End Sub
Function RegExRepl(sString$, sPattern As String, lItem As Long) As String
'aequit 03.03.2020
Static RegEx As RegExp
Dim objMatches As MatchCollection
If RegEx Is Nothing Then Set RegEx = New RegExp
With RegEx
.Global = False
.MultiLine = True
.IgnoreCase = False
.Pattern = sPattern
End With
If Not RegEx.Test(sString) Then
RegExRepl = ""
Exit Function
End If
Set objMatches = RegEx.Execute(sString)
RegExRepl = RegEx.Execute(sString)(0).SubMatches.Item(lItem)
End Function
Изменено: aequit - 04.03.2020 10:55:32(Немного исправил неверное определение цвета текста в зависимости от "+" или "-".)
Здравствуйте! Разбирался с функцией РАБДЕНЬ, возникла необходимость написания данной функции на чистом VBA без использования дополнительных формул и диапазонов на рабочих листах книги. Выкладываю свой вариант для закидывания тапками, может кому пригодится. Можно разместить в личной книге макросов или надстройке. В конце года после выхода постановления Правительства РФ необходимо добавлять в код данные по праздничным и выходным дням, а также по рабочим субботам (внесены данные с 01.01.2015 по текущий год).
Скрытый текст
Код
<…>Function fnСледующийРабочийДень(ByVal dДень As Date, _
Optional ByVal iДобавитьДней As Integer = 1) As Date
If iДобавитьДней > 0 Then
Do While iДобавитьДней > 0
If fnЭтоРабочийДень(dДень + 1) Then
iДобавитьДней = iДобавитьДней - 1
End If
dДень = dДень + 1
Loop
Else
Do While iДобавитьДней < 0
If fnЭтоРабочийДень(dДень - 1) Then
iДобавитьДней = iДобавитьДней + 1
End If
dДень = dДень - 1
Loop
End If
fnСледующийРабочийДень = dДень
End Function
Private Function fnЭтоРабочийДень(ByVal dДень As Date) As Boolean
If Weekday(dДень, vbMonday) <> 6 And Weekday(dДень, vbMonday) <> 7 _
And Not fnЭтоПраздникИлиВыходной(dДень) Or fnЭтоРабочаяСуббота(dДень) Then
fnЭтоРабочийДень = True
Else
fnЭтоРабочийДень = False
End If
End Function
Private Function fnЭтоПраздникИлиВыходной(dДень As Date) As Boolean
Dim arrПраздВых(), i As Long
'Комментарий ниже для примера, какие даты учтены.
'01.01.2015, 02.01.2015, 03.01.2015, 04.01.2015, 05.01.2015, 06.01.2015, 07.01.2015, 08.01.2015, 09.01.2015, 23.02.2015, 08.03.2015,
'01.05.2015, 04.05.2015, 09.05.2015, 11.05.2015, 12.06.2015, 04.11.2015, 01.01.2016, 02.01.2016, 03.01.2016, 04.01.2016, 05.01.2016,
'06.01.2016, 07.01.2016, 08.01.2016, 22.02.2016, 23.02.2016, 07.03.2016, 08.03.2016, 01.05.2016, 02.05.2016, 03.05.2016, 09.05.2016,
'12.06.2016, 13.06.2016, 04.11.2016, 01.01.2017, 02.01.2017, 03.01.2017, 04.01.2017, 05.01.2017, 06.01.2017, 07.01.2017, 08.01.2017,
'23.02.2017, 24.02.2017, 08.03.2017, 01.05.2017, 08.05.2017, 09.05.2017, 12.06.2017, 04.11.2017, 06.11.2017, 01.01.2018, 02.01.2018,
'03.01.2018, 04.01.2018, 05.01.2018, 06.01.2018, 07.01.2018, 08.01.2018, 23.02.2018, 08.03.2018, 09.03.2018, 30.04.2018, 01.05.2018,
'02.05.2018, 09.05.2018, 11.06.2018, 12.06.2018, 04.11.2018, 31.12.2018, 01.01.2019, 02.01.2019, 03.01.2019, 04.01.2019, 05.01.2019,
'06.01.2019, 07.01.2019, 08.01.2019, 23.02.2019, 08.03.2019, 01.05.2019, 02.05.2019, 03.05.2019, 09.05.2019, 10.05.2019, 12.06.2019,
'04.11.2019, 01.01.2020, 02.01.2020, 03.01.2020, 04.01.2020, 05.01.2020, 06.01.2020, 07.01.2020, 08.01.2020, 23.02.2020, 24.02.2020,
'08.03.2020, 09.03.2020, 01.05.2020, 04.05.2020, 05.05.2020, 09.05.2020, 11.05.2020, 12.06.2020, 04.11.2020, 01.01.2021, 02.01.2021,
'03.01.2021, 04.01.2021, 05.01.2021, 06.01.2021, 07.01.2021, 08.01.2021, 23.02.2021, 08.03.2021, 01.05.2021, 09.05.2021, 12.06.2021,
'04.11.2021
'В массив ниже добавить нужные даты праздничных и выходных дней.
arrПраздВых = Array(42005, 42006, 42007, 42008, 42009, 42010, 42011, 42012, 42013, 42058, 42071, 42125, 42128, 42133, 42135, _
42167, 42312, 42370, 42371, 42372, 42373, 42374, 42375, 42376, 42377, 42422, 42423, 42436, 42437, 42491, 42492, 42493, 42499, _
42533, 42534, 42678, 42736, 42737, 42738, 42739, 42740, 42741, 42742, 42743, 42789, 42790, 42802, 42856, 42863, 42864, 42898, _
43043, 43045, 43101, 43102, 43103, 43104, 43105, 43106, 43107, 43108, 43154, 43167, 43168, 43220, 43221, 43222, 43229, 43262, _
43263, 43408, 43465, 43466, 43467, 43468, 43469, 43470, 43471, 43472, 43473, 43519, 43532, 43586, 43587, 43588, 43594, 43595, _
43628, 43773, 43831, 43832, 43833, 43834, 43835, 43836, 43837, 43838, 43884, 43885, 43898, 43899, 43952, 43955, 43956, 43960, _
43962, 43994, 44139, 44197, 44198, 44199, 44200, 44201, 44202, 44203, 44204, 44250, 44263, 44317, 44325, 44359, 44504)
For i = LBound(arrПраздВых) To UBound(arrПраздВых)
If CLng(dДень) = arrПраздВых(i) Then
fnЭтоПраздникИлиВыходной = True
Exit Function
End If
Next i
fnЭтоПраздникИлиВыходной = False
End Function
Private Function fnЭтоРабочаяСуббота(dДень As Date) As Boolean
Dim arrРабСуб(), i As Long
'Комментарий ниже для примера, какие даты учтены.
'20.06.2016, 28.04.2018, 09.06.2018, 29.12.2018
'В массив ниже добавить нужные даты рабочих суббот.
arrРабСуб = Array(42541, 43218, 43260, 43463)
For i = LBound(arrРабСуб) To UBound(arrРабСуб)
If CLng(dДень) = arrРабСуб(i) Then
fnЭтоРабочаяСуббота = True
Exit Function
End If
Next i
fnЭтоРабочаяСуббота = False
End Function<…>