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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 139 След.
HB
 
Андрей, с Днём Рождения! Всегда с интересом читаю Ваши решения, удивляйте ими и дальше!
Power Query при получение данных из Excel теряет нолик
 
В PQ вытягивают все без excel NumberFormat (так устроен PQ), а потом форматируют требуемый столбец вытянутых данных.
Как обработать свойство ячейки .Text в PQ - не знаю, это Максим по ссылке колдовал. Но такой винегрет из форматов не для нормальной обработки, конечно. Это в VBA проще делать.
Изменено: ZVI - 22 окт 2020 00:17:22
Power Query при получение данных из Excel теряет нолик
 
Игорь, в источнике в столбце3 реально - числа, но с форматом ячеек с 12-ю нулями и с выравниванием по левому краю.
Можно было бы просто в источнике применить формат "000-000-000000" и не нужен ни PQ, ни VBA,
но так неинтересно :)
Изменено: ZVI - 21 окт 2020 23:55:14
Power Query при получение данных из Excel теряет нолик
 
Цитата
Hugo написал: Ну а всёж - можно вытянуть то, что указано форматом?
У Андрея форматом (не Excel, а PQ) и вытянуто, там можно сократить:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Таблица4"]}[Content],
    Result = Table.TransformColumns(Source, {"Столбец3", each Number.ToText(_, " 000-000-000000"), Text.Type})
in
    Result
Изменено: ZVI - 21 окт 2020 23:18:12
Отправка писем с других почтовых ящиков (которые также имеются в Outlook)
 
Дмитрий, да, это часто путается, сам тоже участвовал  :)
Отправка писем с других почтовых ящиков (которые также имеются в Outlook)
 
Добрый день, нужно так:
Код
Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item("testmail@mail.ru")

Это относится к коду сообщения #7.
Всесто текстового значения аккаунта (обычно -адреса) можно использовать числовой индекс аккаунта: 1, 2 и т.п.
Изменено: ZVI - 2 сен 2020 19:11:55
Спам.
 
И мне пришло утром, Google переводчик с сомалийского на русский то переводит, а прочитать е-mail адрес в профиле русскоязычного форума не умеет.
Пробил фотку из профиля - использовано фото Abigail Harrison, которая мечтает быть членом космического экипажа экспедиции на Марс, интересная девушка, но она не Джессика. Есть списки адресов таких разводчиков, там можно выбрать и русский язык, что удобно и для разводчиков, наверное.
Напомнило другую Джессику  :)
Изменено: ZVI - 25 авг 2020 12:23:17
Как реализовать в Excel формулами алгоритм теории массового обслуживания Эрланга
 
Erlang C Formula
Нечёткий поиск / Fuzzy Lookup: как повторить или подключиться через VBA
 
Цитата
bedvit написал: правильно ли я понял, что с 30/07/19
Виталий, добрый день.
Независимо от даты, запрещено:
5. SCOPE OF LICENSE. The software is licensed, not sold. This agreement only gives you some rights to use the software. Microsoft reserves all other rights. Unless applicable law gives you more rights despite this limitation, you may use the software only as expressly permitted in this agreement. In doing so, you must comply with any technical limitations in the software that only allow you to use it in certain ways. You may not
reverse engineer, decompile or disassemble the software, except and only to the extent that applicable law expressly permits, despite this limitation;


По поводу #5 - не знаю, не юрист ))
Нечёткий поиск / Fuzzy Lookup: как повторить или подключиться через VBA
 
Кому интересно - здесь есть много разных вариантов кода Fuzzy Matching. Но там нет кода с алгоритмом, использованным в Fuzzy Lookup Add-In for Excel.
Нечёткий поиск / Fuzzy Lookup: как повторить или подключиться через VBA
 
Интересно, что по ссылке для скачивания Fuzzy Lookup Add-In for Excel в разделе Install Instructions написано об условиях лицензии в документе 'LicenseTerms.rtf': "Read the license terms in the 'LicenseTerms.rtf' document."

А в п.2 документа LicenseTerms.rtf был указан срок действия лицензии до 30 июля 2019г.
"2. TERM. The term of this agreement is until 30/07/2019 (day/month/year), or commercial release of the software, whichever is first."

Получается, что юридически срок использования надстройки закончился, несмотря на то, что технически она работоспособна.
Изменено: ZVI - 18 дек 2019 10:21:20
Как сохранять макросы в  свою надстройку
 
В VBE  активировать любое окно надстройки и нажать Ctrl-S
Закодировать данные числами и заменить их на эти числа
 
Цитата
Ігор Гончаренко написал: я бы использовал телефонные коды городов
Игорь, для городов - да, но автор темы в #5 написал, что города привел для примера на форуме, в реальной базе не города.
Закодировать данные числами и заменить их на эти числа
 
Допустим, на листе Лист1 - данные (городов) в ячейке A1 и ниже, столбец B - пустой, в него буду записаны коды (городов).
1. Активировать A1 или любую ячейку с данными в столбце A.
2. На ленте: вкладка "Данные" - группа "Работа с данными", кнопка "Удалить дубликаты" - OK.
При желании можно отсортировать список полученных уникальных данных.
3. В ячейку B1 вписать формулу =СТРОКА(), выделить B1  и нажать на крестик справа внизу на контуре B1 - формула скопируется в ячейки ниже.
4. Допустим на другом листе в ячейке D2 - записан город, чтобы получить его код в E2 используйте формулу =ВПР(D2;Лист3!$A$1:$B$5;2;0)
Ошибка при запуске Run-time error ' 429 ' ActiveX component can't create object
 
Пожалуйста!  :)
Ошибка при запуске Run-time error ' 429 ' ActiveX component can't create object
 
Цитата
bombowoz написал: ...работает на всех компах ... Без птички не работает.
Если птички не жалко, то поставьте ее и используйте такой вариант кода:
Код
Sub Test()
  ' Reference: Tools - References - Windows Script Host Object Model
  ' File: C:\Windows\System32\wshom.ocx
  Dim intReturn
  Dim WshShell As IWshRuntimeLibrary.WshShell
  Set WshShell = New IWshRuntimeLibrary.WshShell
  Range("C20").Value = 255
  intReturn = WshShell.Run("C:\ABC\GetData.exe X", 0, True)
  Range("C20").Value = intReturn
End Sub
Изменено: ZVI - 26 ноя 2019 17:16:35
Ошибка при запуске Run-time error ' 429 ' ActiveX component can't create object
 
Цитата
bombowoz написал: Set WshShell = CreateObject("WScript.Shell")   <<<< на эту строку ругается дебагер
В проекте установите ссылку на Tools - References - Windows Script Host Object Model и проверьте, работает ли такой код:
Код
Sub Test()
  ' Reference: Tools - References - Windows Script Host Object Model
  ' File: C:\Windows\System32\wshom.ocx
  Dim WshShell As IWshRuntimeLibrary.WshShell
  Set WshShell = New IWshRuntimeLibrary.WshShell
  WshShell.Popup "Hi!"
End Sub

Если не работает, то проверьте свои права доступа (правый клик - свойства - Безопасность) на чтение и выполнение для файла C:\Windows\System32\wshom.ocx
Изменено: ZVI - 25 ноя 2019 02:08:59
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Цитата
getana написал:  ZVI , огромное спасибо!
Пожалуйста  :)
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Цитата
БМВ написал:Владимир, вот и Вашему терпению приходит конец :-)
Михаил, добрый вечер. Терпение-то есть ещё, чего не скажешь о желании заниматься догадками наобум без примеров  :)
Изменено: ZVI - 13 ноя 2019 20:06:24
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Пора, наверное,  Вам уже немного VBA подучить, чтобы уметь самостоятельно подгонять код под некоторые несложные нюансы, например, учет минимальной длины.
Или прикладывать тестовые данные и желаемый результат, как предлагалось в конце сообщения 34.
Примера данных и ожидаемого результата так и нет, тестируйте сами:
Код
Sub Main()
   
  Const MinLength = 4                 ' Мин. длина слова в символах
  Const GoodList = "гостиная,душевая" ' Список (белый) допустимых слов
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"   ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([abcekmnhoptuyА-ЯЁ\-]*)[( ]" ' "abcekmnhoptuy" - нерусские буквы, которые могут выглядеть как русские
   
  Dim i As Long, a() As Variant, Obj As Object, Rng As Range, s As String
  Dim Dic As Object, w As Variant
      
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value
     
  ' Создать словарь слов белого списка
  Set Dic = CreateObject("Scripting.Dictionary")
  With Dic
    .CompareMode = 1
    For Each w In Split(GoodList, ",")
      .Item(Trim(w)) = Empty
    Next
  End With
     
  ' Найти первое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"
        ' --> Удаление лишних слов
        'If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец удаления
        .Pattern = Pattern1
        s = .Replace(s, " _")
        .Pattern = Pattern2
        For Each Obj In .Execute("_" & s & " ")
          s = LCase(Obj.SubMatches(0))
          If Dic.Exists(s) Then
            a(i, 1) = s
            Exit For
          End If
          If Len(s) >= MinLength Then
            If s Like "*[а-яё]*" Then
              If InStr(1, ExcludeList, Right(s, 2), vbTextCompare) = 0 Then
                a(i, 1) = s
                Exit For
              End If
            End If
          End If
        Next
      End If
    Next
    Set Obj = Nothing
    Set Dic = Nothing
  End With
   
  ' Поместить результат в столбец [q]
  Rng.EntireRow.Columns("q").Value = a()
    
End Sub
Изменено: ZVI - 13 ноя 2019 19:49:23
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Вот код для "белого" списка с русскими словами любой длины:
Код
Sub Main()
  
  Const MinLength = 4                 ' Мин. длина слова в символах
  Const GoodList = "гостиная,душевая" ' Список (белый) допустимых русских слов
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"   ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([А-ЯЁ\-]*)[( ]"
  
  Dim i As Long, a() As Variant, Obj As Object, Rng As Range, s As String
  Dim Dic As Object, w As Variant
     
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value
    
  ' Создать словарь слов белого списка
  Set Dic = CreateObject("Scripting.Dictionary")
  With Dic
    For Each w In Split(GoodList, ",")
      .Item(Trim(w)) = Empty
    Next
  End With
    
  ' Найти первое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"
        ' --> Удаление лишних слов
        'If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец удаления
        .Pattern = Pattern1
        s = .Replace(s, " _")
        .Pattern = Pattern2
        For Each Obj In .Execute("_" & s & " ")
          s = LCase(Obj.SubMatches(0))
          If Dic.Exists(s) Then
            a(i, 1) = s
            Exit For
          End If
          If InStr(1, ExcludeList, Right(s, 2), vbTextCompare) = 0 Then
            a(i, 1) = s
            Exit For
          End If
        Next
      End If
    Next
    Set Obj = Nothing
    Set Dic = Nothing
  End With
  
  ' Поместить результат в столбец [q]
  Rng.EntireRow.Columns("q").Value = a()
   
End Sub
Изменено: ZVI - 13 ноя 2019 16:22:19
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Цитата
getana написал: не работает белый список
Вы прочитайте, что написано в комментарии к списку:
' Список (белый) допустимых русских слов длиной <  MinLength
А у вас там слово длиннее MinLength.
Потом, наверное, еще окажется, что не только русских слов ))
Опишите правило для этого списка, от него же код меняется радикально.
И в примере приведите, что ожидается
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Так как примера данных нет - тестируйте сами:
Код
Sub Main()
 
  Const MinLength = 4                 ' Мин. длина слова в символах
  Const GoodList = "душ,муж,куш"      ' Список (белый) допустимых русских словё длиной <  MinLength
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"   ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([А-ЯЁ\-]*)[( ]"
 
  Dim i As Long, a() As Variant, Obj As Object, Rng As Range, s As String
  Dim Dic As Object, w As Variant
    
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value
   
  ' Создать словарь слов белого списка
  Set Dic = CreateObject("Scripting.Dictionary")
  With Dic
    For Each w In Split(GoodList, ",")
      .Item(Trim(w)) = Empty
    Next
  End With
   
  ' Найти первое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"
        ' --> Удаление лишних слов
        If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец удаления
        .Pattern = Pattern1
        s = .Replace(s, " _")
        .Pattern = Pattern2
        For Each Obj In .Execute("_" & s & " ")
          s = LCase(Obj.SubMatches(0))
          If Len(s) < MinLength Then
            If Dic.Exists(s) Then
              a(i, 1) = s
              Exit For
            End If
          ElseIf InStr(1, ExcludeList, Right(s, 2), vbTextCompare) = 0 Then
            a(i, 1) = s
            Exit For
          End If
        Next
      End If
    Next
    Set Obj = Nothing
    Set Dic = Nothing
  End With
 
  ' Поместить результат в столбец [e]
  Rng.EntireRow.Columns("e").Value = a()
  
End Sub
Изменено: ZVI - 13 ноя 2019 15:02:05
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Предполагаю, что все-таки так будет лучше:
Код
Sub Main()

  Const MinLength = 4          ' Мин. длина слова в символах
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"  ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([А-ЯЁ\-]{" & MinLength & ",})[( ]"

  Dim i As Long, j As Long, a() As Variant, Obj As Object, Rng As Range, s As String
   
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value

  ' Найти первое русское слова по шаблону
  With New RegExp ' CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"

        ' --> Исключения из правил
        j = InStr(1, s, "душ", 1)
        If j > 0 Then a(i, 1) = "душ"
        'If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец исключений

        .Pattern = Pattern1
        s = .Replace(s, " _")
        .Pattern = Pattern2
        For Each Obj In .Execute("_" & s & " ")
          s = LCase(Obj.SubMatches(0))
          If InStr(ExcludeList, Right(s, 2)) = 0 Then
            If j Then
              If Obj.FirstIndex < j Then a(i, 1) = s
            Else
              a(i, 1) = s
            End If
            Exit For
          End If
        Next
      End If
    Next
    Set Obj = Nothing
  End With

  ' Поместить результат в столбец [h]
  Rng.EntireRow.Columns("h").Value = a()
End Sub
Как из текста при получении русского слова исключить слова, содержащие в конце слова ая или ый или ое?, в продолжение темы "Как из текста-каши получить первое русское слово"
 
Правило для  2-й строки тогда изменилось, пробуйте такой вариант:
Код
Sub Main()
 
  Const MinLength = 4          ' Мин. длина слова в символах
  Const ExcludeList = "ая,ый,ое,ий,ой,ые,яя,ся,ее"  ' Окончания игнорируемых слов
  Const Pattern1 = "[\u00A0,\.\/ ]"  ' 1-й символ это CHR(160), последний - пробел
  Const Pattern2 = "\b_([А-ЯЁ\-]{" & MinLength & ",})[( ]"
     
  Dim i As Long, a() As Variant, Obj As Object, Rng As Range, s As String
   
  ' Задать диапазон входных данных
  With ThisWorkbook.Sheets(1)
    Set Rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
  End With
  a() = Rng.Value
       
  ' Найти первое русское слова по шаблону
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    For i = 1 To UBound(a)
      s = Trim(a(i, 1))
      If Len(s) = 0 Then
        a(i, 1) = Empty
      Else
        a(i, 1) = "(нет)"
         
        ' --> Исключения из правил
        If InStr(1, s, "душ", 1) = 1 Then
          a(i, 1) = "душ"
        Else
          'If InStr(1, s, "хром", 1) > 0 Then s = Replace(s, "хром", "", Compare:=1)
        ' <-- Конец исключений
           
          .Pattern = Pattern1
          s = .Replace(s, " _")
          .Pattern = Pattern2
          For Each Obj In .Execute("_" & s & " ")
            s = LCase(Obj.SubMatches(0))
            If InStr(ExcludeList, Right(s, 2)) = 0 Then
              a(i, 1) = s
              Set Obj = Nothing
              Exit For
            End If
          Next
        End If
      End If
    Next
  End With
     
  ' Поместить результат в столбец [h]
  Rng.EntireRow.Columns("h").Value = a()
End Sub

Ранее наличие слова "душ" означало результат = "душ", или другое слово, если найдется, сейчас же только первое слово "душ" приводит к результату "душ".
Подозреваю, что со сменой правила что-то в результатах может и нарушиться - пишите подробнее, что нужно или приведите больше данных, на которых проявляются проблемы.
Изменено: ZVI - 13 ноя 2019 01:07:05
Сортировка Excel не различает "И" и "Й" в тексте
 
У меня русская Windows 10 Pro 64 бит, и в Excel 2010 32 бит, и в Excel 2016 64бит сортируется корректно.
Проверил в Win XP SP3 - сортировка правильная в Excel 2003, 2007, 2010 - все 32 битные.
Но у меня для исключения кракозябр (русификации) файл C_1252.NLS в указанных операционных системах заменен на C_1251.NLS , может, в этом отличие, хотя вряд ли.
Изменено: ZVI - 3 ноя 2019 11:39:30
Сортировка Excel не различает "И" и "Й" в тексте
 
Нормально сортирует:
ИF
ИN
ИZ
ЙD
ЙG
ЙQ
Уточните, в какой версии Excel сортирует неправильно?
И какая языковая локализация Office и операционной системы?
Изменено: ZVI - 3 ноя 2019 00:58:26
Сохранить в PDF на vbs
 
Михаил и Владимир, спасибо, что поверили!
Но моем компьютере проблема из-за того, что сначала был установлен 64-битный Offiсe 2016 64bit, а затем Office 2010 32bit, что-то в реестре некорректно теперь.
Изменено: ZVI - 25 окт 2019 04:19:38
Макросом вывести робочую книгу в защищеный просмотр
 
Ну да, предварительный просмотр означает просмотр до редактирования, а после режима редактирования он уже не может быть предварительным
Макросом вывести робочую книгу в защищеный просмотр
 
Цитата
dxf написал: ...можно на активной книге это cделать...
Нет. Разве что закрыть и снова открыть, но нет в этом смысла. Дмитрий (The_Prist) уже объяснял, как правильно работать с книгами.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 139 След.
Наверх