Attribute VB_Name = "ex_DataPreparation" ' ======== Data manipulation tools ============ ' Shared module version: 20220217 ' Depends on: ' Required reference: Option Private Module Option Explicit Public Function ApplyCommonAbbreviations(sText$) As String Dim sResult$: sResult = sText sResult = VBA.Replace(sResult, Chr(9), " ") sResult = VBA.Replace(sResult, Chr(160), " ") sResult = VBA.Replace(sResult, "(с изменениями и дополнениями)", "") sResult = VBA.Replace(sResult, " ", " ") sResult = VBA.Replace(sResult, "Российская Федерация", "РФ") sResult = VBA.Replace(sResult, "Россия", "РФ") sResult = VBA.Replace(sResult, "Федеральный закон", "ФЗ") sResult = VBA.Replace(sResult, "Постановление Правительства", "ПП") sResult = VBA.Replace(sResult, "Распоряжение Правительства", "РП") sResult = VBA.Replace(sResult, "Российской Федерации", "РФ") sResult = VBA.Replace(sResult, "России", "РФ") sResult = VBA.Replace(sResult, "Федерального закона", "ФЗ") sResult = VBA.Replace(sResult, "Постановления Правительства", "ПП") sResult = VBA.Replace(sResult, "Распоряжения Правительства", "РП") sResult = VBA.Replace(sResult, "Министерство внутренних дел", "МВД") sResult = VBA.Replace(sResult, "Министерство иностранных дел", "МИД") sResult = VBA.Replace(sResult, "Министерство обороны", "Минобороны") sResult = VBA.Replace(sResult, "Министерство юстиции", "Минюст") sResult = VBA.Replace(sResult, "Министерство здравоохранения", "Минздрав") sResult = VBA.Replace(sResult, "Министерство культуры", "Минкультуры") sResult = VBA.Replace(sResult, "Министерство образования и науки", "Минобрнауки") sResult = VBA.Replace(sResult, "Министерство природных ресурсов и экологии", "Минприроды") sResult = VBA.Replace(sResult, "Министерство промышленности и торговли", "Минпромторг") sResult = VBA.Replace(sResult, "Министерство Российской Федерации по развитию Дальнего Востока", "Минвостокразвития РФ") sResult = VBA.Replace(sResult, "Министерство регионального развития", "Минрегион") sResult = VBA.Replace(sResult, "Министерство связи и массовых коммуникаций", "Минкомсвязь") sResult = VBA.Replace(sResult, "Министерство сельского хозяйства", "Минсельхоз") sResult = VBA.Replace(sResult, "Министерство спорта", "Минспорт") sResult = VBA.Replace(sResult, "Министерство транспорта", "Минтранса") sResult = VBA.Replace(sResult, "Министерство труда и социальной защиты", "Минтруд") sResult = VBA.Replace(sResult, "Министерство финансов", "Минфин") sResult = VBA.Replace(sResult, "Министерство экономического развития", "Минэкономразвития") sResult = VBA.Replace(sResult, "Министерство энергетики", "Минэнерго") sResult = VBA.Replace(sResult, "Министерство строительства и жилищно-коммунального хозяйства", "Минстрой") sResult = VBA.Replace(sResult, "Министерства внутренних дел", "МВД") sResult = VBA.Replace(sResult, "Министерства иностранных дел", "МИД") sResult = VBA.Replace(sResult, "Министерства обороны", "Минобороны") sResult = VBA.Replace(sResult, "Министерства юстиции", "Минюста") sResult = VBA.Replace(sResult, "Министерства здравоохранения", "Минздрава") sResult = VBA.Replace(sResult, "Министерства культуры", "Минкультуры") sResult = VBA.Replace(sResult, "Министерства образования и науки", "Минобрнауки") sResult = VBA.Replace(sResult, "Министерства природных ресурсов и экологии", "Минприроды") sResult = VBA.Replace(sResult, "Министерства промышленности и торговли", "Минпромторга") sResult = VBA.Replace(sResult, "Министерства Российской Федерации по развитию Дальнего Востока", "Минвостокразвития РФ") sResult = VBA.Replace(sResult, "Министерства регионального развития", "Минрегиона") sResult = VBA.Replace(sResult, "Министерства связи и массовых коммуникаций", "Минкомсвязи") sResult = VBA.Replace(sResult, "Министерства сельского хозяйства", "Минсельхоза") sResult = VBA.Replace(sResult, "Министерства спорта", "Минспорта") sResult = VBA.Replace(sResult, "Министерства транспорта", "Минтранса") sResult = VBA.Replace(sResult, "Министерства труда и социальной защиты", "Минтруда") sResult = VBA.Replace(sResult, "Министерства финансов", "Минфина") sResult = VBA.Replace(sResult, "Министерства экономического развития", "Минэкономразвития") sResult = VBA.Replace(sResult, "Министерства энергетики", "Минэнерго") sResult = VBA.Replace(sResult, "Министерства строительства и жилищно-коммунального хозяйства", "Минстроя") sResult = VBA.Replace(sResult, "Федеральная служба по техническому и экспортному контролю", "ФСТЭК") sResult = VBA.Replace(sResult, "Федеральная служба безопасности", "ФСБ") sResult = VBA.Replace(sResult, "Федеральная служба Российской Федерации по контролю за оборотом наркотиков", "ФСКН РФ") sResult = VBA.Replace(sResult, "Федеральная служба охраны", "ФСО") sResult = VBA.Replace(sResult, "Федеральная служба по гидрометеорологии и мониторингу окружающей среды", "Росгидромет") sResult = VBA.Replace(sResult, "Федеральная служба по экологическому, технологическому и атомному надзору", "Ростехнадзор") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере природопользования", "Росприроднадзор") sResult = VBA.Replace(sResult, "Федеральная служба по ветеринарному и фитосанитарному надзору", "Россельхознадзор") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере транспорта", "Ространснадзор") sResult = VBA.Replace(sResult, "Федеральная служба по труду и занятости", "Роструд") sResult = VBA.Replace(sResult, "Федеральная служба по регулированию алкогольного рынка", "Росалкогольрегулирование") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере связи, информационных технологий и массовых коммуникаций", "Роскомнадзор") sResult = VBA.Replace(sResult, "Федеральная служба по аккредитации", "Росаккредитация") sResult = VBA.Replace(sResult, "Федеральная служба государственной статистики", "Росстат") sResult = VBA.Replace(sResult, "Федеральная служба по интеллектуальной собственности", "Роспатент") sResult = VBA.Replace(sResult, "Федеральная служба по финансовому мониторингу", "Росфинмониторинг") sResult = VBA.Replace(sResult, "Федеральная служба государственной регистрации, кадастра и картографии", "Росреестр") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере защиты прав потребителей и благополучия человека", "Роспотребнадзор") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере здравоохранения", "Росздравнадзор") sResult = VBA.Replace(sResult, "Федеральная служба по надзору в сфере образования и науки", "Рособзнадзор") sResult = VBA.Replace(sResult, "Федеральная служба по экологическому, технологическому и атомному надзору", "Ростехнадзор") sResult = VBA.Replace(sResult, "Федеральное агентство по техническому регулированию и метрологии", "Росстандарт") sResult = VBA.Replace(sResult, "Федеральное агентство водных ресурсов", "Росводресурсы") sResult = VBA.Replace(sResult, "Федеральное агентство лесного хозяйства", "Рослесхоз") sResult = VBA.Replace(sResult, "Федеральное агентство по недропользованию", "Роснедра") sResult = VBA.Replace(sResult, "Федеральное агентство по рыболовству", "Росрыболовство") sResult = VBA.Replace(sResult, "Федеральное агентство воздушного транспорта", "Росавиация") sResult = VBA.Replace(sResult, "Федеральное агентство железнодорожного транспорта", "Росжелдор") sResult = VBA.Replace(sResult, "Федеральное агентство морского и речного транспорта", "Росморречфлот") sResult = VBA.Replace(sResult, "Федеральное агентство по управлению государственным имуществом", "Росимущество") sResult = VBA.Replace(sResult, "Федеральное агентство по печати и массовым коммуникациям", "Роспечать") sResult = VBA.Replace(sResult, "Федеральное агентство связи", "Россвязь") sResult = VBA.Replace(sResult, "Федеральное агентство по туризму", "Ростуризм") sResult = VBA.Replace(sResult, "Федеральное агентство по государственным резервам", "Росрезерв") sResult = VBA.Replace(sResult, "Федеральное агентство по делам молодёжи", "Росмолодёжь") sResult = VBA.Replace(sResult, "Федеральное агентство по делам национальностей", "ФАДН") sResult = VBA.Replace(sResult, "Федеральная налоговая служба", "ФНС") sResult = VBA.Replace(sResult, "Федеральная таможенная служба", "ФТС") sResult = VBA.Replace(sResult, "Государственная фельдъегерская служба", "ГФС") sResult = VBA.Replace(sResult, "Федеральная антимонопольная служба", "ФАС") sResult = VBA.Replace(sResult, "Федеральное медико-биологическое агентство", "ФМБА") sResult = VBA.Replace(sResult, "Федеральное архивное агентство", "Росархив") sResult = VBA.Replace(sResult, "Федеральное космическое агентство", "Роскосмос") sResult = VBA.Replace(sResult, "Федеральное дорожное агентство", "Росавтодор") sResult = VBA.Replace(sResult, "Пенсионный фонд", "ПФ") sResult = VBA.Replace(sResult, "Федеральный фонд обязательного медицинского страхования", "ФОМС") sResult = VBA.Replace(sResult, "Фонд социального страхования", "ФСС") sResult = VBA.Replace(sResult, "Федеральной службы по техническому и экспортному контролю", "ФСТЭК") sResult = VBA.Replace(sResult, "Федеральной службы безопасности", "ФСБ") sResult = VBA.Replace(sResult, "Федеральной службы Российской Федерации по контролю за оборотом наркотиков", "ФСКН РФ") sResult = VBA.Replace(sResult, "Федеральной службы охраны", "ФСО") sResult = VBA.Replace(sResult, "Федеральной службы по гидрометеорологии и мониторингу окружающей среды", "Росгидромета") sResult = VBA.Replace(sResult, "Федеральной службы по экологическому, технологическому и атомному надзору", "Ростехнадзора") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере природопользования", "Росприроднадзора") sResult = VBA.Replace(sResult, "Федеральной службы по ветеринарному и фитосанитарному надзору", "Россельхознадзора") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере транспорта", "Ространснадзора") sResult = VBA.Replace(sResult, "Федеральной службы по труду и занятости", "Роструда") sResult = VBA.Replace(sResult, "Федеральной службы по регулированию алкогольного рынка", "Росалкогольрегулирования") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере связи, информационных технологий и массовых коммуникаций", "Роскомнадзора") sResult = VBA.Replace(sResult, "Федеральной службы по аккредитации", "Росаккредитации") sResult = VBA.Replace(sResult, "Федеральной службы государственной статистики", "Росстата") sResult = VBA.Replace(sResult, "Федеральной службы по интеллектуальной собственности", "Роспатента") sResult = VBA.Replace(sResult, "Федеральной службы по финансовому мониторингу", "Росфинмониторинга") sResult = VBA.Replace(sResult, "Федеральной службы государственной регистрации, кадастра и картографии", "Росреестра") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере защиты прав потребителей и благополучия человека", "Роспотребнадзора") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере здравоохранения", "Росздравнадзора") sResult = VBA.Replace(sResult, "Федеральной службы по надзору в сфере образования и науки", "Рособзнадзора") sResult = VBA.Replace(sResult, "Федеральной службы по экологическому, технологическому и атомному надзору", "Ростехнадзора") sResult = VBA.Replace(sResult, "Федерального агентства по техническому регулированию и метрологии", "Росстандарта") sResult = VBA.Replace(sResult, "Федерального агентства водных ресурсов", "Росводресурсов") sResult = VBA.Replace(sResult, "Федерального агентства лесного хозяйства", "Рослесхоза") sResult = VBA.Replace(sResult, "Федерального агентства по недропользованию", "Роснедр") sResult = VBA.Replace(sResult, "Федерального агентства по рыболовству", "Росрыболовства") sResult = VBA.Replace(sResult, "Федерального агентства воздушного транспорта", "Росавиации") sResult = VBA.Replace(sResult, "Федерального агентства железнодорожного транспорта", "Росжелдора") sResult = VBA.Replace(sResult, "Федерального агентства морского и речного транспорта", "Росморречфлота") sResult = VBA.Replace(sResult, "Федерального агентства по управлению государственным имуществом", "Росимущества") sResult = VBA.Replace(sResult, "Федерального агентства по печати и массовым коммуникациям", "Роспечати") sResult = VBA.Replace(sResult, "Федерального агентства связи", "Россвязи") sResult = VBA.Replace(sResult, "Федерального агентства по туризму", "Ростуризма") sResult = VBA.Replace(sResult, "Федерального агентства по государственным резервам", "Росрезерва") sResult = VBA.Replace(sResult, "Федерального агентства по делам молодёжи", "Росмолодёжи") sResult = VBA.Replace(sResult, "Федерального агентства по делам национальностей", "ФАДН") sResult = VBA.Replace(sResult, "Федеральной налоговой службы", "ФНС") sResult = VBA.Replace(sResult, "Федеральной таможенной службы", "ФТС") sResult = VBA.Replace(sResult, "Государственной фельдъегерской службы", "ГФС") sResult = VBA.Replace(sResult, "Федеральной антимонопольной службы", "ФАС") sResult = VBA.Replace(sResult, "Федерального медико-биологического агентства", "ФМБА") sResult = VBA.Replace(sResult, "Федерального архивного агентства", "Росархива") sResult = VBA.Replace(sResult, "Федерального космического агентства", "Роскосмоса") sResult = VBA.Replace(sResult, "Федерального дорожного агентства", "Росавтодора") sResult = VBA.Replace(sResult, "Пенсионного фонда", "ПФ") sResult = VBA.Replace(sResult, "Федерального фонда обязательного медицинского страхования", "ФОМС") sResult = VBA.Replace(sResult, "Фонда социального страхования", "ФСС") sResult = VBA.Replace(sResult, "Российская академия наук", "РАН") sResult = VBA.Replace(sResult, "Российской академии наук", "РАН") sResult = VBA.Replace(sResult, "Федеральная служба", "ФС") sResult = VBA.Replace(sResult, "Федеральной службы", "ФС") sResult = VBA.Replace(sResult, "сельское хозяйство", "с/х") sResult = VBA.Replace(sResult, "сельского хозяйства", "с/х") sResult = VBA.Replace(sResult, "сельскому хозяйству", "с/х") sResult = VBA.Replace(sResult, "сельском хозяйстве", "с/х") sResult = VBA.Replace(sResult, "железнодорожный", "ж/д") sResult = VBA.Replace(sResult, "железнодорожного", "ж/д") sResult = VBA.Replace(sResult, "железнодорожному", "ж/д") sResult = VBA.Replace(sResult, "железнодорожном", "ж/д") sResult = VBA.Replace(sResult, "железнодорожная", "ж/д") sResult = VBA.Replace(sResult, "железнодорожной", "ж/д") sResult = VBA.Replace(sResult, "железнодорожную", "ж/д") sResult = VBA.Replace(sResult, "железнодорожное", "ж/д") sResult = VBA.Replace(sResult, "железнодорожным", "ж/д") sResult = VBA.Replace(sResult, " ", " ") ApplyCommonAbbreviations = sResult End Function Public Function SafeFileName(sText$) As String Dim sResult$: sResult = sText sResult = VBA.Replace(sResult, "*", "x") sResult = VBA.Replace(sResult, "?", "7") sResult = VBA.Replace(sResult, "/", "-") sResult = VBA.Replace(sResult, "\", "-") sResult = VBA.Replace(sResult, "|", "l") sResult = VBA.Replace(sResult, ":", " ") sResult = VBA.Replace(sResult, "<", "") sResult = VBA.Replace(sResult, ">", "") sResult = VBA.Replace(sResult, """", "'") sResult = VBA.Replace(sResult, "' ", "'") sResult = VBA.Replace(sResult, Chr(11), " ") sResult = VBA.Replace(sResult, Chr(13), " ") sResult = VBA.Replace(sResult, Chr(160), " ") sResult = VBA.Replace(sResult, Chr(9), " ") sResult = VBA.Replace(sResult, Chr(7), " ") sResult = VBA.Replace(sResult, " ", " ") SafeFileName = sResult End Function Public Function QuotedStr(sText$) As String QuotedStr = """" & sText & """" End Function Public Function TrimWhitespace(ByVal target$) As String Dim sResult$: sResult = target Dim bChanged As Boolean: bChanged = True Do While bChanged If VBA.Len(sResult) < 1 Then _ Exit Do bChanged = False If IsWhitespace(VBA.Left(sResult, 1)) Then sResult = VBA.Right(sResult, Len(sResult) - 1) bChanged = True End If If VBA.Len(sResult) < 1 Then _ Exit Do If IsWhitespace(VBA.Right(sResult, 1)) Then sResult = VBA.Left(sResult, VBA.Len(sResult) - 1) bChanged = True End If Loop TrimWhitespace = sResult End Function Public Function TrimEndPunctuation(ByVal target$) As String Dim sResult$: sResult = target Dim isChanged As Boolean: isChanged = True Do While isChanged isChanged = False If VBA.Len(sResult) < 1 Then _ GoTo END_LOOP If IsPunctuation(VBA.Right(sResult, 1)) Then sResult = VBA.Left(sResult, VBA.Len(sResult) - 1) isChanged = True End If END_LOOP: Loop TrimEndPunctuation = sResult End Function Public Function SubstituteWhitespace(ByVal target$) As String SubstituteWhitespace = VBA.Replace(target, Chr(160), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, Chr(7), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, Chr(10), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, Chr(13), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, Chr(9), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, Chr(11), " ") SubstituteWhitespace = VBA.Replace(SubstituteWhitespace, " ", " ") SubstituteWhitespace = Trim(SubstituteWhitespace) End Function Public Function FixSpecialSymbols(ByVal target$) As String FixSpecialSymbols = VBA.Replace(target, Chr(160), " ") FixSpecialSymbols = VBA.Replace(FixSpecialSymbols, Chr(7), " ") FixSpecialSymbols = VBA.Replace(FixSpecialSymbols, Chr(10), " ") FixSpecialSymbols = VBA.Replace(FixSpecialSymbols, Chr(13), " ") FixSpecialSymbols = VBA.Replace(FixSpecialSymbols, Chr(9), " ") FixSpecialSymbols = VBA.Replace(FixSpecialSymbols, Chr(11), " ") End Function Public Function CapitalizeFirstLetter(target$) As String If VBA.Len(target) > 1 Then CapitalizeFirstLetter = VBA.UCase(VBA.Left(target, 1)) & VBA.Right(target, VBA.Len(target) - 1) Else CapitalizeFirstLetter = target End If End Function Public Function IsAlphaNumeric(sText$) As Boolean IsAlphaNumeric = VBA.Len(sText) > 0 And Not sText Like "*[!a-zA-Zа-яА-ЯёЁ0-9]*" End Function ' ================ Private Function IsWhitespace(sSymbol$) As Boolean IsWhitespace = True If sSymbol = " " Then Exit Function ElseIf sSymbol = Chr(7) Then Exit Function ElseIf sSymbol = Chr(9) Then Exit Function ElseIf sSymbol = Chr(13) Then Exit Function ElseIf sSymbol = Chr(11) Then Exit Function ElseIf sSymbol = Chr(10) Then Exit Function ElseIf sSymbol = Chr(160) Then Exit Function End If IsWhitespace = False End Function Private Function IsPunctuation(sSymbol$) As Boolean IsPunctuation = True If sSymbol = "." Then Exit Function ElseIf sSymbol = "," Then Exit Function ElseIf sSymbol = "-" Then _ Exit Function ElseIf sSymbol = ChrW(&H2013) Then _ Exit Function ElseIf sSymbol = ChrW(&H2012) Then _ Exit Function ElseIf sSymbol = ChrW(&H2010) Then _ Exit Function ElseIf sSymbol = ";" Then Exit Function ElseIf sSymbol = " " Then Exit Function ElseIf sSymbol = "!" Then Exit Function ElseIf sSymbol = ":" Then Exit Function ElseIf sSymbol = "?" Then Exit Function ElseIf sSymbol = """" Then Exit Function ElseIf sSymbol = "Chr(85)" Then Exit Function End If IsPunctuation = False End Function