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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 139 След.
Нечёткий поиск / 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) уже объяснял, как правильно работать с книгами.
Сохранить в PDF на vbs
 
Цитата
БМВ написал: ...для глянца...
Доброе утро, Михаил. Наверное, надо, но это же "рыба" :)
Мне сейчас даже проверить не на чем - из VBS ни GetObject, ни CreateObject почему-то не запускаются, требуют повышения
Изменено: ZVI - 24 Окт 2019 10:11:50
Сохранить в PDF на vbs
 
Цитата
Дмитрий_DimAs написал: конвертировать файлы типа .png, .jpg, и ещё забыл про .dwg и .dxf(автокадовские)
Такими вопросами не интересовался. Наверное, всё кроме dwg, можно загружать в Word/Excel и конвертировать аналогично.
А вот больше одного вопроса в теме здесь запрещено задавать  ;)
Сохранить в PDF на vbs
 
Не тестировал, но что-то типа такого должно работать, насколько я понял проблему:
Код
Call CreatePdf
Sub CreatePdf()
  Dim Excel, arg, FileName, i
  On Error Resume Next
  Set Excel = CreateObject("Excel.Application")
  If Err Then
    MsgBox "Excel is not created"
    Exit Sub
  End If
  On Error GoTo 0
  'Excel.Visible = True
  For Each arg In WScript.Arguments
    With Excel.Workbooks.Open(arg, False, True)
      FileName = Excel.ActiveWorkbook.FullName
      i = InStrRev(FileName, ".")
      If i > 1 Then FileName = Left(FileName, i - 1)
      Excel.ActiveSheet.ExportAsFixedFormat 0, FileName, 0, True, False, , , False
      .Close False
    End With
  Next
  Excel.Quit
  Set Excel = Nothing
End Sub
Изменено: ZVI - 24 Окт 2019 09:16:35
Сохранить в PDF на vbs
 
Цитата
Дмитрий_DimAs написал: я запускаю файл, который нужно пересохранить и потом перетаскиваю его на иконку скрипта и он срабатывает
Доброе утро,
Непонятна конечная цель, так как в первом сообщении было как раз об активной книге, т.е. открытой в Excel.
Если тот код не годится, то лучше  сформулируйте задачу не кодом, а словами - что ожидается от VBS.
Про меню правой кнопки мне тоже непонятно, дайте ссылку на тему или, чтобы не запутаться, лучше обсуждать только VBS.
В Excel есть 'Сохранить как PDF', зачем тогда VBS?
Сам VBS не может сохранять в PDF,  но может вызывать приложение, которое это сделает.
Например, VBS сам может создать объект (CreateObject) Excel, загрузить в него нужную книгу, сохранить как PDF и закрыть Excel.
Изменено: ZVI - 24 Окт 2019 08:43:04
Макросом вывести робочую книгу в защищеный просмотр
 
Цитата
dxf написал: каr сделать чтобы открывались постоянно в защищенном режиме, путь прописан в макросе  с диска d/
Код
Option Explicit

Dim w As ProtectedViewWindow

Sub OpenProtectedView()
  Set w = Application.ProtectedViewWindows.Open("D:\Книга1.xlsb")
End Sub

Sub EditProtectedView()
  w.Edit
End Sub
Изменено: ZVI - 15 Ноя 2019 01:00:03
Восстановление связи с Ribbon
 
Цитата
despot69 написал: вы получите формулу "=33333333",
Код
Pointer = CLng([RibbonPointer]) =CLng("=33333333")
что приводит к ошибке.
Как-то мы увлеклись интересными высказываниями, но в цитате выше утверждение неверное.
У Автора темы все правильно: [RibbonPointer] = Evaluate("RibbonPointer") и выдает требуемое число, так как RibbonPointer это не переменная, а имя.
При открытии существующего файла появляется второе окно
 
Похоже, это как-то связано с окном защищенного просмотра.
Не стал разбираться, понимая, что это взялось ниоткуда и само должно уйти вникуда.
Подождал месяц (подписка обновленний такая) на берегу, пока проблема проплыла мимо :)
Изменено: ZVI - 20 Окт 2019 00:30:44
При открытии существующего файла появляется второе окно
 
Юрий, добрый вечер.
Было и у меня такое, подождал обновления операционки и офиса - исчезло, вроде.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 139 След.
Наверх