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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 23 След.
Отмеченные данные копировать в таблицу на другом листе
 
Цитата
deliome написал:
В строку "Hazards"
На каком листе эта строка.
Цитата
deliome написал:
какие макросы нужно назначить кнопкам
Те, которые вы, либо кто-то напишет.
Цитата
deliome написал:
правильно ли настроены чекбоксы?
Это Вам решать.
WebService(): как работает эта функция ИМЕННО в макросе?
 
Можно так попробовать
Код
Sub сэмэсэ()
    Dim запрос$, ответ$
    URL = "https://api.anysite.com/simple/send?phone=xxxxxxxxxxxx&text=hello+world&username=yyy&password=zzz"
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", запрос, False 'может вместо get будет post
        .send
        Do: DoEvents: Loop Until .ReadyState = 4
        ответ = .responsetext
    End With
    Beep
    MsgBox ответ
End Sub
Изменено: kalbasiatka - 11 Янв 2019 22:11:17
Перенос строки с одного листа в другие по условию
 
Код
Sub uuu()
    Dim a()
    Dim i&, lr&
'------------
    Application.ScreenUpdating = False
    a = Sheets("БД").UsedRange.Value
    For i = 3 To UBound(a) - 1
        On Error Resume Next
        With Sheets(a(i, 2))
            lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            For j = 1 To UBound(a, 2)
                .Cells(lr, j) = a(i, j)
            Next
        End With
        If Err Then Err.Clear
    Next
    Application.ScreenUpdating = True
    Beep
    MsgBox "Приехали!"
End Sub
Форматирование ячеек надо сделать ручками.
Web запрос. Спарсить значения с сайта производителя
 
Цитата
ilyas355 написал: слишком мудрёно
Денег просят?

Вот эти вещи творят чудеса:
CreateObject("msxml2.xmlhttp")
CreateObject("htmlFile")
Запрос XML на URL. Отправлять СМС непосредственно из книги EXEL., Запрос XML
 
И даже ссылку не дадите, неужели бесплатный сервис?
Определить какие из фрагментов есть в общей фразе и обозначить их соответствующими метками
 
Скрытый текст
Изменено: kalbasiatka - 21 Май 2018 19:15:31
Рандомная пауза в макросе
 
1-20 секунд это длительность паузы, это время до запуска паузы от начала выполнения цикла?
Проверка макросом соответствия шапки таблицы шаблону
 
Код
Sub Глaбол()
    Dim a()
    Dim j&
'-----------
    a = Sheets("Шапка").UsedRange.Rows(21).Value
    With CreateObject("Scripting.Dictionary")
        For j = 1 To UBound(a, 2)
            If a(1, j) <> "" Then .Item(a(1, j)) = ""
        Next
        a = Sheets("Шапка").UsedRange.Rows(1).Value
        For j = 1 To UBound(a, 2)
            If a(1, j) <> "" Then
                If Not .Exists(a(1, j)) Then
                    MsgBox "Нет заголовка """ & a(1, j) & """"
                    Exit Sub
                End If
            End If
        Next
    End With
    Beep
    MsgBox "Всё на месте"
End Sub
Определить, есть ли лист в закрытой книге с заданным именем - VBA, если да то.....если нет то...
 
Открывать каждый файл и смотреть, какие листы в нём есть.
Как найти родительский элемент для тега <table>, Требуется найти родительский тэг для тэга <table>
 
элемент.ParentNode
Перенос данных таблицы с помощью макроса по критерию >0
 
Вариант
Код
Sub uuu()
    Dim a()
    Dim i&, rw&
'----------------
    Application.ScreenUpdating = False
    rw = 2
    a = Sheets("Выгрузка").UsedRange.Value
    With Sheets("Отчет")
        For i = 2 To UBound(a)
            If a(i, 1) > 0 Then
                .Cells(rw, 1) = a(i, 1)
                .Cells(rw, 3) = a(i, 3)
                rw = rw + 1
            End If
        Next
        .Activate
    End With
    Application.ScreenUpdating = True
    Beep
End Sub
задать рабочую область в excel
 
Цитата
Виктор C написал:
Подскажите пожалуйста как задать правильно рабочую область
Сколько будет данных на листе такая и будет рабочая область
Становимся в A1 жмякаем Ctr+Shift+End - имеем выделенную рабочую область. Если в неё входят пустые строки то их надо удалить и сохранить файл.
задать рабочую область в excel
 
Перейти на макросы!
Разбить очень крупный файл csv
 
emeditor открывает большие текстовые файлы.
Извлечение данных из XML файлов в Excel
 
Вариант 1. Если знаем что и где лежит.
Код
Sub nnn()
    Dim a()
    Dim fl$
'---------------
    fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
    With CreateObject("MSXML2.DOMDocument")
        .Load fl
        ReDim a(1 To 7)
        a(1) = .SelectSingleNode("//Файл/Документ/СвНП").GetAttribute("ОКПО")
        a(2) = .SelectSingleNode("//Файл/Документ/Баланс/Актив").GetAttribute("СумОтч")
        a(3) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/МатВнеАкт").GetAttribute("СумОтч")
        a(4) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/НеМатФинАкт").GetAttribute("СумОтч")
        a(5) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/Запасы").GetAttribute("СумОтч")
        a(6) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ДенежнСр").GetAttribute("СумОтч")
        a(7) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ФинВлож").GetAttribute("СумОтч")
    End With
    Cells(3, 1).Resize(1, UBound(a)) = a
End Sub
Вариант 2. Если знаем не всё.
Код
Sub uuu()
    Dim a()
    Dim nd, at
    Dim fl$
'---------------
    fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
    With CreateObject("MSXML2.DOMDocument")
        .Load fl
        ReDim a(1 To 7)
        For Each nd In .getElementsByTagName("*")
            If nd.NodeName = "СвНП" Then
                a(1) = nd.GetAttribute("ОКПО")
            Else
                For Each at In nd.Attributes
                    If at.Name = "КодСтроки" Then
                        Select Case at.Value
                            Case "1600": a(2) = nd.GetAttribute("СумОтч")
                            Case "1150": a(3) = nd.GetAttribute("СумОтч")
                            Case "1170": a(4) = nd.GetAttribute("СумОтч")
                            Case "1210": a(5) = nd.GetAttribute("СумОтч")
                            Case "1250": a(6) = nd.GetAttribute("СумОтч")
                            Case "1260": a(7) = nd.GetAttribute("СумОтч")
                        End Select
                    End If
                Next
            End If
        Next
    End With
    Cells(3, 1).Resize(1, UBound(a)) = a
End Sub
Изменено: kalbasiatka - 26 Сен 2017 23:44:11
[ Закрыто] Посчитать количество строк в .csv файле
 
Цитата
chopper написал:
но завершить не удается
А начало покажете?
сопоставление большого объема данных
 
Код
Sub uuu()
    Dim a()
    Dim i&
    Dim sd As Object
'----------------------
    a = Sheets(2).UsedRange.Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
        sd.Item(a(i, 1)) = a(i, 2)
    Next
    With Sheets(1)
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If sd.Exists(a(i, 1)) Then
                a(i, 4) = sd.Item(a(i, 1))
            End If
        Next
        .Cells(1, 1).Resize(UBound(a), UBound(a, 2)) = a
    End With
    Beep
    MsgBox "Готово!"
End Sub
[ Закрыто] Вероятность выигрыша
 
Цитата
Ronin751 написал:
Вам бы вначале курс комбинаторики изучить
При чём тут комбинаторика, тут фарт надо и карты нормальные на руки.
VBA массив задан двумерным. Можно ли ему ещё задать третье и более измерение?
 
Цитата
kalbasiatka написал:
Массив массивов. Словарь массивов(словарей).
Смотрю в монитор вижу ... что хочу!
VBA массив задан двумерным. Можно ли ему ещё задать третье и более измерение?
 
Массив массивов. Словарь массивов(словарей). Но, если вы снова со своим поиском, то и 5-е измерение вам не поможет.
VBA Как организовать сверхбыстрый поиск пары слов с пропущенными буквами?
 
tod2020, тут тема есть про скачивание файла через IE - не Вы, случайно? Точно так же человек отстаивает свою позицию.
Ответ на вопрос можно ли в словаре искать неточное совпадение - нет. Это всё равно будет цикл.
Для ускорения поиска по массиву, как уже говорилось, искомое значение берём в переменную и, если совпадение будет одно, то используем exit for после того, как нашли значение.
Код
s = Cells(9, 3)
For i = 1 To UBound(a)
    If a(i, 1) Like s Then
        MsgBox a(i, 2)
        Exit For
    End If
Next
VBA Как организовать сверхбыстрый поиск пары слов с пропущенными буквами?
 
Цитата
tod2020 написал:
Нет, нужно в словаре
Ну значит не будет ни как
VBA Как организовать сверхбыстрый поиск пары слов с пропущенными буквами?
 
Искать в массиве, словарь не нужен.
Код
Sub uuu()
    Dim a()
    Dim i&
'-----------
    a = Range("Table1").Value
    For i = 1 To UBound(a)
        If a(i, 1) Like Cells(9, 3) Then
            Beep
            MsgBox a(i, 1)
        End If
    Next
End Sub
Изменено: kalbasiatka - 19 Авг 2017 18:14:57
IE скачать файл, vba
 
Цитата
JeyCi написал:
лишь бы иметь уверенность, что эта библиотека всегда есть на компе?
Была бы винда остальное найдётся, правда
Цитата
MSDN: Minimum supported client - Windows XP
IE скачать файл, vba
 
Цитата
JeyCi написал:
а сам URLDownloadToFile забыли?
Это кому и о чём речь?
IE скачать файл, vba
 
Вариант без IE.
Код
#If Win64 Then
    #If VBA7 Then
        Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _
                 ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong
    #Else
        Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _
                ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong
    #End If
#Else
    #If VBA7 Then
        Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
                 ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    #Else
        Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
                ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    #End If
#End If

Sub uuu()
    Dim url$, fn$, ex$
    Dim sp
'------------------------
    url = "http://am.cdnmob.org/pic/v2/gallery/preview/abstrakciya-fon-40658.jpg"
    sp = Split(url, ".")
    ex = sp(UBound(sp))
    fn = ThisWorkbook.Path & "\файл из интернета." & ex
    URLDownloadToFile 0, url, fn, 0, 0
    Beep
End Sub
Изменено: kalbasiatka - 19 Авг 2017 09:22:05
Единый массив данных на один лист из множества книг, Единый массив данных на один лист из множества книг
 
Цитата
vke-student написал:
Как макрос написать?
Руками.
Открываем редактор vba и пишем.
Скорее всего уже есть готовые, надо просто поиском воспользоваться. Не мне, вам, если что.
Единый массив данных на один лист из множества книг, Единый массив данных на один лист из множества книг
 
Ctrl + C / Ctrl + V либо макрос написать
Изменено: kalbasiatka - 18 Авг 2017 19:12:45
Неоднозначность работы Environ$("%temp%") на различных Windows
 
Скрытый текст
переделать макросы для скачивания котировок., YAHOO
 
Цитата
copper-top написал:
учусь и балуюсь.
Цитата
copper-top написал:
осталось найти того, кто напишет для этого макрос на безвозмездной основе
CreateObject("msxml2.xmlhttp") + CreateObject("HtmlFile") - безвозмездно, а дальше действуем по первой цитате.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 23 След.
Наверх