Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Результаты поиска
krosav4ig Дата: Суббота, 22.04.2017, 03:58 | Сообщение № 1461 | Тема: Как перезапустить Microsoft Outlook макросом?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Outlook может попросить что-то с ними сделать.

а чтобы не просил, можно [vba]
Код
CreateObject("Wscript.Shell").run "cmd /c taskkill /f /im outlook.exe & start outlook.exe", 0, false
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Outlook может попросить что-то с ними сделать.

а чтобы не просил, можно [vba]
Код
CreateObject("Wscript.Shell").run "cmd /c taskkill /f /im outlook.exe & start outlook.exe", 0, false
[/vba]

Автор - krosav4ig
Дата добавления - 22.04.2017 в 03:58
krosav4ig Дата: Пятница, 28.04.2017, 15:30 | Сообщение № 1462 | Тема: Копирование число по середине текста
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще до кучи
Код
=ТЕКСТ('расчет еу'!G5;"""Недостача составляет ""0_ ""долла"&ТЕКСТ(ОСТАТ(МАКС(ОСТАТ('расчет еу'!G5-11;100);9);10);"[<1]р;[>4]ров;ра")&""",_ 00_ ")&"цен"&ТЕКСТ(ОСТАТ(МАКС(ОСТАТ(100*ОКРУГЛ(ОСТАТ('расчет еу'!G5;1);2)-11;100);9);10);"[<1]т;[>4]тов;та")


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениееще до кучи
Код
=ТЕКСТ('расчет еу'!G5;"""Недостача составляет ""0_ ""долла"&ТЕКСТ(ОСТАТ(МАКС(ОСТАТ('расчет еу'!G5-11;100);9);10);"[<1]р;[>4]ров;ра")&""",_ 00_ ")&"цен"&ТЕКСТ(ОСТАТ(МАКС(ОСТАТ(100*ОКРУГЛ(ОСТАТ('расчет еу'!G5;1);2)-11;100);9);10);"[<1]т;[>4]тов;та")

Автор - krosav4ig
Дата добавления - 28.04.2017 в 15:30
krosav4ig Дата: Четверг, 28.09.2017, 12:26 | Сообщение № 1463 | Тема: Навигация по контролам запраш. № семейства не существует.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте. [vba]
Код
Sub Latkir()
    If Not Selection.Information(wdWithInTable) Then Exit Sub
    Select Case Selection.Rows(1).index
        Case 1 To 3, 8 To 11
            ActivateKeyboardLayout kb_lay_ru, 0
        Case 4 To 7
            ActivateKeyboardLayout kb_lay_en, 0
    End Select
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте. [vba]
Код
Sub Latkir()
    If Not Selection.Information(wdWithInTable) Then Exit Sub
    Select Case Selection.Rows(1).index
        Case 1 To 3, 8 To 11
            ActivateKeyboardLayout kb_lay_ru, 0
        Case 4 To 7
            ActivateKeyboardLayout kb_lay_en, 0
    End Select
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 28.09.2017 в 12:26
krosav4ig Дата: Воскресенье, 22.10.2017, 18:17 | Сообщение № 1464 | Тема: Выборка значения из массива
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Добрый вечер. ВПР()

upd.
не обратил внимания, что не по первому столбцу? массивная формула
Код
=ВПР(I2;Если({1;0};R3:R20;Q3:Q20);2;)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 22.10.2017, 18:50
 
Ответить
СообщениеДобрый вечер. ВПР()

upd.
не обратил внимания, что не по первому столбцу? массивная формула
Код
=ВПР(I2;Если({1;0};R3:R20;Q3:Q20);2;)

Автор - krosav4ig
Дата добавления - 22.10.2017 в 18:17
krosav4ig Дата: Понедельник, 30.10.2017, 15:26 | Сообщение № 1465 | Тема: Сумма данных по условию уникального значения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте. Еще вариант формулы для файла из 7 поста
Код
=СЧЁТ(1/ЧАСТОТА(ЕСЛИ(($J14:$AC14=AG14)*$J16:$AC300;$H16:$H300);$H16:$H300))
К сообщению приложен файл: 1794053.xls (81.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте. Еще вариант формулы для файла из 7 поста
Код
=СЧЁТ(1/ЧАСТОТА(ЕСЛИ(($J14:$AC14=AG14)*$J16:$AC300;$H16:$H300);$H16:$H300))

Автор - krosav4ig
Дата добавления - 30.10.2017 в 15:26
krosav4ig Дата: Пятница, 03.11.2017, 16:19 | Сообщение № 1466 | Тема: Перенос данных из ячеек таблицы Excel в таблицу базы данных.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
вариант с recordset (с небольшой махинацией :) )
[vba]
Код
Private Sub CommandButton1_Click()
      Dim path$, DbPath$, fieldnames$, values$, connStr$, sql$
10  On Error GoTo CommandButton1_Click_Error
    
20    path = ThisWorkbook.path: DbPath = path & "\Table.accdb"
30    fieldnames = "[Дата обработки Заявки], [Название организации], [Кол-во техники, шт], [СУММА СЧЕТА], [Вывезли?]"
40    values = Join(Array(Format(Me.[B3], "\#yyyy-MM-dd#"), "'" & [B2] & "'", [B4], [B5], [B6] = "Да"), ",")
50    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Mode=Read;Extended Properties=text;Data Source=" & path
60    sql = "insert into TOV (" & fieldnames & ") IN '" & DbPath & "' values (" & values & ")"
70    CreateObject("adodb.recordset").Open sql, connStr
        Debug.Print Application.VBE.ActiveCodePane.CodeModule.Name
80  On Error GoTo 0
90    Exit Sub
    
CommandButton1_Click_Error:
      With Application.VBE.ActiveCodePane
          MsgBox "Ошибка " & Err.Number & " (" & Err.Description & _
              ") в процедуре " & .CodeModule.ProcOfLine(.TopLine, 0) & _
              " модуля " & .CodeModule.Name & " на строке " & Erl
      End With
End Sub
[/vba]
К сообщению приложен файл: 5735043.xlsm (20.4 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 04.11.2017, 15:10
 
Ответить
Сообщениевариант с recordset (с небольшой махинацией :) )
[vba]
Код
Private Sub CommandButton1_Click()
      Dim path$, DbPath$, fieldnames$, values$, connStr$, sql$
10  On Error GoTo CommandButton1_Click_Error
    
20    path = ThisWorkbook.path: DbPath = path & "\Table.accdb"
30    fieldnames = "[Дата обработки Заявки], [Название организации], [Кол-во техники, шт], [СУММА СЧЕТА], [Вывезли?]"
40    values = Join(Array(Format(Me.[B3], "\#yyyy-MM-dd#"), "'" & [B2] & "'", [B4], [B5], [B6] = "Да"), ",")
50    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Mode=Read;Extended Properties=text;Data Source=" & path
60    sql = "insert into TOV (" & fieldnames & ") IN '" & DbPath & "' values (" & values & ")"
70    CreateObject("adodb.recordset").Open sql, connStr
        Debug.Print Application.VBE.ActiveCodePane.CodeModule.Name
80  On Error GoTo 0
90    Exit Sub
    
CommandButton1_Click_Error:
      With Application.VBE.ActiveCodePane
          MsgBox "Ошибка " & Err.Number & " (" & Err.Description & _
              ") в процедуре " & .CodeModule.ProcOfLine(.TopLine, 0) & _
              " модуля " & .CodeModule.Name & " на строке " & Erl
      End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 03.11.2017 в 16:19
krosav4ig Дата: Пятница, 03.11.2017, 16:36 | Сообщение № 1467 | Тема: Консолидация в одной книге данных из других закрытых книг
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Не знаю как с Mac, но для WIndows можно как-то так
файл должен лежать в папке с базами

на листе QueryTable, в модуле листа код для обновления подключения
для обновления ПКМ по таблице>обновить
[vba]
Код
Private WithEvents qt As QueryTable
Private Sub ss()
    Set qt = [Консолидация].ListObject.QueryTable
    qt.Connection = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Mode=Read;Extended Properties=text;Data Source=" & Me.path
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    ss
End Sub
Private Sub Workbook_Open()
    ss
End Sub
Private Sub qt_BeforeRefresh(Cancel As Boolean)
    Dim Command$()
    Dim f$, s$, v&
    f = Me.path:
    s = Dir$(f & "\*.xls*")
    Do
        If Not s Like "~$*" And s <> Me.Name Then
            ReDim Preserve Command(v):
            Command$(v) = Application.Text$(s, _
                """select *,'""@""' From [Лист1$] IN '" & _
                f & "\""@""' [excel 12.0 xml;HDR=No]""")
                v = v + 1
        End If
        s = Dir$()
    Loop While s <> ""
    qt.CommandText = Join(Command, " union all ")
    DoEvents
End Sub
[/vba]
К сообщению приложен файл: 0876980.xlsm (26.6 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеНе знаю как с Mac, но для WIndows можно как-то так
файл должен лежать в папке с базами

на листе QueryTable, в модуле листа код для обновления подключения
для обновления ПКМ по таблице>обновить
[vba]
Код
Private WithEvents qt As QueryTable
Private Sub ss()
    Set qt = [Консолидация].ListObject.QueryTable
    qt.Connection = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Mode=Read;Extended Properties=text;Data Source=" & Me.path
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    ss
End Sub
Private Sub Workbook_Open()
    ss
End Sub
Private Sub qt_BeforeRefresh(Cancel As Boolean)
    Dim Command$()
    Dim f$, s$, v&
    f = Me.path:
    s = Dir$(f & "\*.xls*")
    Do
        If Not s Like "~$*" And s <> Me.Name Then
            ReDim Preserve Command(v):
            Command$(v) = Application.Text$(s, _
                """select *,'""@""' From [Лист1$] IN '" & _
                f & "\""@""' [excel 12.0 xml;HDR=No]""")
                v = v + 1
        End If
        s = Dir$()
    Loop While s <> ""
    qt.CommandText = Join(Command, " union all ")
    DoEvents
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 03.11.2017 в 16:36
krosav4ig Дата: Пятница, 03.11.2017, 17:08 | Сообщение № 1468 | Тема: как правильно отсортировать товар по дате поступления??
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
здравствуйте
вариант с доп. столбцом
Код
=НАИМЕНЬШИЙ(ЕСЛИ(Лист2!$A$1:A99=Лист1!$A$2;СТРОКА(Лист2!$A$1:A99));СТРОКА(Лист1!G1))

и формула в таблице
Код
=ИНДЕКС(ВЫБОР(ОКРВВЕРХ(СТОЛБЕЦ()/3;1);Лист2!$A:$A;Лист2!$B:$B);$G2+(ОСТАТ(СТОЛБЕЦ();3)=0))
К сообщению приложен файл: 9274373.xlsx (15.2 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениездравствуйте
вариант с доп. столбцом
Код
=НАИМЕНЬШИЙ(ЕСЛИ(Лист2!$A$1:A99=Лист1!$A$2;СТРОКА(Лист2!$A$1:A99));СТРОКА(Лист1!G1))

и формула в таблице
Код
=ИНДЕКС(ВЫБОР(ОКРВВЕРХ(СТОЛБЕЦ()/3;1);Лист2!$A:$A;Лист2!$B:$B);$G2+(ОСТАТ(СТОЛБЕЦ();3)=0))

Автор - krosav4ig
Дата добавления - 03.11.2017 в 17:08
krosav4ig Дата: Пятница, 03.11.2017, 17:29 | Сообщение № 1469 | Тема: Смешанная ссылка в формуле
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Копируете формулу или ячейку с формулой?
Вставьте формулу в ячейку, скопируйте ячейку и вставляйте ее куда вам нужно


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеКопируете формулу или ячейку с формулой?
Вставьте формулу в ячейку, скопируйте ячейку и вставляйте ее куда вам нужно

Автор - krosav4ig
Дата добавления - 03.11.2017 в 17:29
krosav4ig Дата: Пятница, 03.11.2017, 17:36 | Сообщение № 1470 | Тема: Смешанная ссылка в формуле
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
а формат ячеек случайно не текстовый?
а вообще посмотреть бы на файл-пример...


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 03.11.2017, 17:37
 
Ответить
Сообщениеа формат ячеек случайно не текстовый?
а вообще посмотреть бы на файл-пример...

Автор - krosav4ig
Дата добавления - 03.11.2017 в 17:36
krosav4ig Дата: Воскресенье, 05.11.2017, 21:47 | Сообщение № 1471 | Тема: Автоматическая печать ссылок
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте [vba]
Код
Sub PrintAll()
    Dim v As Variant
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
    With CreateObject("Shell.Application").Namespace(0)
        For Each v In Range([B3], [B3].End(xlDown)).Value
            On Error Resume Next
            .ParseName(v).InvokeVerbEx "Print"
            If Err Then 'если файл не найден
                'On Error GoTo 0: Err.Raise 53
                Debug.Print v: Err.Clear 'пишем путь пропущенного файла в immediate
            End If
        Next
    End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub
[/vba]
К сообщению приложен файл: 2029169.xlsm (15.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте [vba]
Код
Sub PrintAll()
    Dim v As Variant
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
    With CreateObject("Shell.Application").Namespace(0)
        For Each v In Range([B3], [B3].End(xlDown)).Value
            On Error Resume Next
            .ParseName(v).InvokeVerbEx "Print"
            If Err Then 'если файл не найден
                'On Error GoTo 0: Err.Raise 53
                Debug.Print v: Err.Clear 'пишем путь пропущенного файла в immediate
            End If
        Next
    End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 05.11.2017 в 21:47
krosav4ig Дата: Четверг, 09.11.2017, 17:45 | Сообщение № 1472 | Тема: как правильно отсортировать товар по дате поступления??
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
куча формул (волатильных!!!)
в диспетчере имен
Код
AA    =ЯЧЕЙКА("имяфайла";Лист1!K1)
Код
BB    =ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(AA;"]";ПОВТОР(" ";999));ПОИСК("[";AA)+1;999)))
Код
CC    =ПОИСКПОЗ(BB;BB;)
Код
DD    =СЧЁТЕСЛИ(ДВССЫЛ("'"&BB&"'!A:A");Лист1!$A$2)
Код
EE    =МУМНОЖ((CC<=ТРАНСП(CC))*(DD);ТРАНСП(CC^0))
Код
FF    =ИНДЕКС(BB;ПОИСКПОЗ(СТРОКА()-1;EE)+1)
Код
GG    =ПОЛУЧИТЬ.ДОКУМЕНТ(10; FF)
Код
HH    =ДВССЫЛ("'"&FF&"'!A1:A"&GG)
Код
II    =ДВССЫЛ("'"&FF&"'!B1:B"&GG;1)
Код
JJ    =СТРОКА()-ПРОСМОТР(СТРОКА()-1;EE)
Код
KK    =НАИМЕНЬШИЙ(ЕСЛИ(HH=Лист1!$A$2;СТРОКА(HH));JJ)
Код
LL    =ИНДЕКС(ВЫБОР(ОКРВВЕРХ(СТОЛБЕЦ()/3;1);HH;II);KK+(ОСТАТ(СТОЛБЕЦ();3)=0))
в ячейках
Код
=ЕСЛИ(СТРОКА()-1>=СУММ(DD);"";LL)
К сообщению приложен файл: 6508847.xlsm (20.1 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 09.11.2017, 17:49
 
Ответить
Сообщениекуча формул (волатильных!!!)
в диспетчере имен
Код
AA    =ЯЧЕЙКА("имяфайла";Лист1!K1)
Код
BB    =ПОЛУЧИТЬ.РАБОЧУЮ.КНИГУ(1;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(AA;"]";ПОВТОР(" ";999));ПОИСК("[";AA)+1;999)))
Код
CC    =ПОИСКПОЗ(BB;BB;)
Код
DD    =СЧЁТЕСЛИ(ДВССЫЛ("'"&BB&"'!A:A");Лист1!$A$2)
Код
EE    =МУМНОЖ((CC<=ТРАНСП(CC))*(DD);ТРАНСП(CC^0))
Код
FF    =ИНДЕКС(BB;ПОИСКПОЗ(СТРОКА()-1;EE)+1)
Код
GG    =ПОЛУЧИТЬ.ДОКУМЕНТ(10; FF)
Код
HH    =ДВССЫЛ("'"&FF&"'!A1:A"&GG)
Код
II    =ДВССЫЛ("'"&FF&"'!B1:B"&GG;1)
Код
JJ    =СТРОКА()-ПРОСМОТР(СТРОКА()-1;EE)
Код
KK    =НАИМЕНЬШИЙ(ЕСЛИ(HH=Лист1!$A$2;СТРОКА(HH));JJ)
Код
LL    =ИНДЕКС(ВЫБОР(ОКРВВЕРХ(СТОЛБЕЦ()/3;1);HH;II);KK+(ОСТАТ(СТОЛБЕЦ();3)=0))
в ячейках
Код
=ЕСЛИ(СТРОКА()-1>=СУММ(DD);"";LL)

Автор - krosav4ig
Дата добавления - 09.11.2017 в 17:45
krosav4ig Дата: Пятница, 10.11.2017, 17:13 | Сообщение № 1473 | Тема: Как работает простая функция-аналог ВПР.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
зачем стоит знак "&"
это символ типа данных (Long)
что будет если его ("&") убрать
Тип данных станет variant
должно сначала идти условие но там стоит col + Abs(col)
эт просто настроение было игривое :) VBA любое числовое значение<>0 при преобразовании в логический тип данных интерпретирует как True, а 0 соответственно - False. Т.е. [vba]
Код
col + Abs(col) ≡ col>0
[/vba]
Что такое col в этой функции?
Номер столбца в диапазоне, содержащий возвращаемое значение
если номер столбца не отрицательный, можно пользовать встроенную функцию VLookup
[vba]
Код
Sub макрос()
    
    Dim sh_mat As Worksheet, sh_spravka As Worksheet
    Dim i As Long, lr As Long
    
    
    '1. Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
    
    '2. Присваиваем имена листам, с которыми надо работать, чтобы по этим именам обращаться к листам.
    Set sh_mat = Worksheets("MaterialsNorms")
    Set sh_spravka = Worksheets("Справочник")
    '3. Удаление строк на листе "MaterialsNorms", у которых пусто в столбце 4.
    ' Поиск последней строки. Не должно быть скрытых строк, т.к. End не ищет в скрытых строках.
    lr = sh_mat.Cells(sh_mat.Rows.Count, 2).End(xlUp).row
    With sh_mat.Range("D10:D" & lr)
        ' Удаление.
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        '4. Заполнение столбца 6 на листе "MaterialsNorms".
        .Offset(0, 2).Value = Application.VLookup(.Value, sh_spravka.UsedRange.Columns("A:B"), 2, 0)
    End With
    
    '5. Вкл. монитора.
    Application.ScreenUpdating = True
    
    '6. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 10.11.2017, 17:20
 
Ответить
Сообщение
зачем стоит знак "&"
это символ типа данных (Long)
что будет если его ("&") убрать
Тип данных станет variant
должно сначала идти условие но там стоит col + Abs(col)
эт просто настроение было игривое :) VBA любое числовое значение<>0 при преобразовании в логический тип данных интерпретирует как True, а 0 соответственно - False. Т.е. [vba]
Код
col + Abs(col) ≡ col>0
[/vba]
Что такое col в этой функции?
Номер столбца в диапазоне, содержащий возвращаемое значение
если номер столбца не отрицательный, можно пользовать встроенную функцию VLookup
[vba]
Код
Sub макрос()
    
    Dim sh_mat As Worksheet, sh_spravka As Worksheet
    Dim i As Long, lr As Long
    
    
    '1. Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
    
    '2. Присваиваем имена листам, с которыми надо работать, чтобы по этим именам обращаться к листам.
    Set sh_mat = Worksheets("MaterialsNorms")
    Set sh_spravka = Worksheets("Справочник")
    '3. Удаление строк на листе "MaterialsNorms", у которых пусто в столбце 4.
    ' Поиск последней строки. Не должно быть скрытых строк, т.к. End не ищет в скрытых строках.
    lr = sh_mat.Cells(sh_mat.Rows.Count, 2).End(xlUp).row
    With sh_mat.Range("D10:D" & lr)
        ' Удаление.
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        '4. Заполнение столбца 6 на листе "MaterialsNorms".
        .Offset(0, 2).Value = Application.VLookup(.Value, sh_spravka.UsedRange.Columns("A:B"), 2, 0)
    End With
    
    '5. Вкл. монитора.
    Application.ScreenUpdating = True
    
    '6. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 10.11.2017 в 17:13
krosav4ig Дата: Понедельник, 13.11.2017, 18:51 | Сообщение № 1474 | Тема: поиск значений по нескольким условиям
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
здравствуйте
Код
=ЕСЛИОШИБКА(ПРОСМОТР(;-1/($D$2:$D$22="Центр")/($A$2:$A$22=A2);$C$2:$C$22);"")
К сообщению приложен файл: 6187866.xlsx (9.8 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениездравствуйте
Код
=ЕСЛИОШИБКА(ПРОСМОТР(;-1/($D$2:$D$22="Центр")/($A$2:$A$22=A2);$C$2:$C$22);"")

Автор - krosav4ig
Дата добавления - 13.11.2017 в 18:51
krosav4ig Дата: Понедельник, 13.11.2017, 20:01 | Сообщение № 1475 | Тема: Поиск значений и выделение ячейки цветом
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
private sub worksheet_change(byval target as range)
    on error goto err
    with target
        select case true
            case .address() = "$G$1"
                [a:a].interior.color = xlnone
                with [a:a].find(.value, , xlvalues, 1)
                    .interior.color = vbgreen
                    application.goto .offset(0, 1), 1
                end with
            case .address like "$B$*"
                select case lcase(.value)
                    case "v", "vv", "+"
                        .interior.color = vbgreen
                end select
        end select
    end with
    exit sub
err:
    msgbox "ошибка", 16
end sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
private sub worksheet_change(byval target as range)
    on error goto err
    with target
        select case true
            case .address() = "$G$1"
                [a:a].interior.color = xlnone
                with [a:a].find(.value, , xlvalues, 1)
                    .interior.color = vbgreen
                    application.goto .offset(0, 1), 1
                end with
            case .address like "$B$*"
                select case lcase(.value)
                    case "v", "vv", "+"
                        .interior.color = vbgreen
                end select
        end select
    end with
    exit sub
err:
    msgbox "ошибка", 16
end sub
[/vba]

Автор - krosav4ig
Дата добавления - 13.11.2017 в 20:01
krosav4ig Дата: Вторник, 14.11.2017, 18:33 | Сообщение № 1476 | Тема: Создание выпадающего списка
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
какое то время
какое?
а потом ошибка
после каких действий?
если ошибка возникает при прокрутке ListBox, то нужно сделать проверку значения ListIndex[vba]
Код
Sub DropDown_click()
    SetVariables
    If DropDown.ListIndex Then
        Range(TextBox.LinkedCell) = DropDown.List(DropDown.Value)
        DeleteElements
    End If
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
какое то время
какое?
а потом ошибка
после каких действий?
если ошибка возникает при прокрутке ListBox, то нужно сделать проверку значения ListIndex[vba]
Код
Sub DropDown_click()
    SetVariables
    If DropDown.ListIndex Then
        Range(TextBox.LinkedCell) = DropDown.List(DropDown.Value)
        DeleteElements
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 14.11.2017 в 18:33
krosav4ig Дата: Воскресенье, 19.11.2017, 13:51 | Сообщение № 1477 | Тема: Ссылка на область в сводной
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте. Попробуйте вот так[vba]
Код
pt.PivotSelect "name[" & sName & "]start1", 1
Set ptRng = Selection
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте. Попробуйте вот так[vba]
Код
pt.PivotSelect "name[" & sName & "]start1", 1
Set ptRng = Selection
[/vba]

Автор - krosav4ig
Дата добавления - 19.11.2017 в 13:51
krosav4ig Дата: Среда, 22.11.2017, 15:07 | Сообщение № 1478 | Тема: Сохранение заданного диапазона - как картинки.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще вариант
Модуль modPastePicture, взят тут (файл PastePicture.zip)
в модуле Лист3 [vba]
Код
Private Sub range2bmp()
    Dim InitialFileName$, FileFilter$, FilePath$
    Me.Range([C4] & ":" & [D4]).CopyPicture xlScreen, xlBitmap
    InitialFileName = ActiveWorkbook.Path & "\*.bmp"
    FileFilter = "Растровое изображение (*.bmp), *.bmp"
    FilePath = Application.GetSaveAsFilename(InitialFileName, FileFilter)
    If FilePath <> "False" Then SavePicture PastePicture(xlBitmap), FilePath Else Err.Raise 380
End Sub
[/vba]
К сообщению приложен файл: 1055408.zip (54.1 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 23.11.2017, 13:40
 
Ответить
Сообщениееще вариант
Модуль modPastePicture, взят тут (файл PastePicture.zip)
в модуле Лист3 [vba]
Код
Private Sub range2bmp()
    Dim InitialFileName$, FileFilter$, FilePath$
    Me.Range([C4] & ":" & [D4]).CopyPicture xlScreen, xlBitmap
    InitialFileName = ActiveWorkbook.Path & "\*.bmp"
    FileFilter = "Растровое изображение (*.bmp), *.bmp"
    FilePath = Application.GetSaveAsFilename(InitialFileName, FileFilter)
    If FilePath <> "False" Then SavePicture PastePicture(xlBitmap), FilePath Else Err.Raise 380
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 22.11.2017 в 15:07
krosav4ig Дата: Воскресенье, 26.11.2017, 21:40 | Сообщение № 1479 | Тема: Проверить наличие автофильтра в умной таблице
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
И так тоже можно [vba]
Код
[GROUPP].ListObject.ShowAutoFilter
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеИ так тоже можно [vba]
Код
[GROUPP].ListObject.ShowAutoFilter
[/vba]

Автор - krosav4ig
Дата добавления - 26.11.2017 в 21:40
krosav4ig Дата: Среда, 06.12.2017, 15:13 | Сообщение № 1480 | Тема: Поделитесь "Вашим методом" поиска объекта, метода, свойства.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 06.12.2017, 15:28
 
Ответить
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!