Вопрос не по Excel, поэтому в Курилке. Но знаю, что здесь есть знатоки вроде doober и Игорь
Хочу парсить МегаМаркет. Что делаю: 1. Беру страницу, например, https://megamarket.ru/catalog/fitnes-braslety/page-1/ 2. Щелкаю кнопку перехода на вторую страницу, чтобы ссылка стала https://megamarket.ru/catalog/fitnes-braslety/page-2/ и смотрю какие запросы отправляются в Chrome на вкладке Network 3. Нахожу нужный запрос, копирую его cURL и вставляю его в Insomnia. Но уже там в ответ мне возвращается "Произошла ошибка. Попробуйте отключить VPN или подключиться к другой сети. Если проблема повторяется, напишите нам в чат или позвоните 8 800 600-08-88'". Похожая ошибка у человека здесь https://zelenka.guru/threads/5653020/?pget=1
Друзья, добрый день! Хочу сделать проверку наличия у пользователя PQ, чтобы вывести ему фразу "у Вас отсутствует Power Query" вместо непонятных обывателю ошибок. Пробую так:
Код
Function IsPowerQueryAvailable() As Boolean
Dim bAvailable As Boolean
On Error Resume Next
bAvailable = Application.COMAddIns("Microsoft.Mashup.Client.Excel").Connect
On Error GoTo 0
IsPowerQueryAvailable = bAvailable
End Function
Sub test()
MsgBox IsPowerQueryAvailable
End Sub
Если у пользователя 2010 или 2013 офис, то макрос отрабатывает корректно. Но если, 2016 и старше, то всегда выдает False. Видимо, потому что PQ там встроен, а не отдельной надстройкой идет. Так вот, как тогда соорудить такую проверку? К моему макросу добавить проверку на версию офиса (во всех ли ревизиях и версиях от 16 офиса и новее есть PQ?)? Или есть какой-то более красивый и надежный способ?
Друзья, добрый день! В этой теме при решении столкнулся с такой проблемой. Через VBA создаю PQ запросы. Имя запроса, имя таблицы и имя листа берутся из таблицы DistinctValues. При повторном запуске кода, хочу чтобы если такой запрос/лист уже есть, то просто переходило к следующему значению в списке DistinctValues. Сейчас подумал, понимаю, что тупанул и можно просто проверить есть ли лист с таким названием в книге, но все равно интересно следующее: Ставлю On Error Resume Next, чтобы когда возникнет ошибка, что запрос с таким именем уже существует, что-то с этим сделать. Ставлю MsgBox Err.Number, получаю код ошибки и увожу на ErrHandler. Т.е. в первом цикле все хорошо. Но во втором, получаю тот же код ошибки, но при этом Resume Next Не срабатывает и открывается дебагер. Почему так себя ведет, в чем ошибка?
Спасибо.
Код
Код
Sub Макрос1()
For Each objConnection In ThisWorkbook.Connections
'Get current background-refresh value
bBackground = objConnection.OLEDBConnection.BackgroundQuery
'Temporarily disable background-refresh
objConnection.OLEDBConnection.BackgroundQuery = False
'Refresh this connection
objConnection.Refresh
'Set background-refresh value back to original value
objConnection.OLEDBConnection.BackgroundQuery = bBackground
Next
For Each cell In Range("DistinctValues")
On Error Resume Next
ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Источник = Excel.CurrentWorkbook(){[Name=""Таблица""]}[Content]," & Chr(13) & "" & Chr(10) & " ChangeType = Table.TransformColumnTypes(Источник,{{""№"", Int64.Type}, {""код"", type text}, {""Ограничения"", type text}})," & Chr(13) & "" & Chr(10) & " ToRows = Table.ToRows(ChangeType)," & Chr(13) & "" & Chr(10) & " RecordsToRemove = Table.ToRows(#""Задублированные строки"")," & Chr(13) & "" & Chr(10) & " DuplicatesRemoves = Table.FromRows(List.RemoveMatchin" & _
"gItems(ToRows,RecordsToRemove), Table.ColumnNames(ChangeType))," & Chr(13) & "" & Chr(10) & " Filter = Table.SelectRows(DuplicatesRemoves, each ([Ограничения] = """ & cell.Value & """))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Filter"
MsgBox Err.Number
On Error GoTo ErrHandler
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & cell.Value & ";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & cell.Value & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_" & Replace(Replace(cell.Value, " ", "_"), ",", "")
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = cell.Value
ErrHandler:
'On Error GoTo 0
Next cell
End Sub
Друзья, доброго времени суток! Решал челлендж на одном из сайтов по PQ, немного его видоизменил, чтобы усложнить, и предлагаю поучавстсовать желающим потому что кажется, что сильно перемудрил при его решении. Задача такова. Есть таблица: Необходимо получить диапазон значений от From до To. Если To не заполнен, то в результате только From. To всегда больше чем From. Буквы это как бы продолжение чисел, т.е. должно идти так 6, 7, 8, 9, A, B, C...128, 129, 12A...12Z, 130. Вроде понятно, в приложенном файле желаемый результат, на нем понятней будет. Всем предложившим варианты спасибо.
Что получилось у меня
Код
let
Источник = Table.TransformColumnTypes(Excel.CurrentWorkbook(){[Name="IDGen"]}[Content],{{"From", type text}, {"To", type text}, {"Amount", Int64.Type}}),
sub = Table.FromList({Text.From(0)..Text.From(9)}&{"A".."Z"}),
count = Table.AddColumn(Источник, "count", (r)=>
[a = List.Generate(
()=> [x=0, flag = 0],
each [flag] <> 1,
each if Text.Range(r[From], [x], 1) = Text.Range(r[To], [x], 1)
then [x =[x]+1, flag = 0]
else [x =[x], flag = 1],
each [x]
),
b = List.Count(a)-1,
c = if b = 0 then 0 else Text.Length(r[From]) - a{b}
][c]
),
values = Table.AddColumn(count, "values", (r)=> let cnt = r[count] in
if cnt > 1 then
List.Accumulate(
{1..r[count]-1},
sub,
(s,c)=>
let
a = Table.AddColumn(s, "col"&Text.From(c), each sub),
b = Table.ExpandTableColumn(a,"col"&Text.From(c),{"Column1"},{"col"&Text.From(c)}),
d = Table.CombineColumns(b,Table.ColumnNames(b),Combiner.CombineTextByDelimiter("", QuoteStyle.None),"Column1"),
e = Table.AddIndexColumn(d,"index",1,1)
in
e
)
else let
a = sub,
b = Table.AddIndexColumn(a,"index",1,1)
in
b
),
range = Table.AddColumn(values, "ID", (r)=> if r[To] = null then {r[From]} else
let
tbl = r[values],
f = Text.End(r[From],r[count]),
l= Text.End(r[To],r[count]),
a = {Table.SelectRows(tbl, each [Column1]=f)[index]{0}..Table.SelectRows(tbl, each [Column1]=l)[index]{0}},
b = Table.SelectRows(tbl, each List.ContainsAny({_[index]}, a))[Column1],
c = List.Transform(b, each Text.Start(r[From], Text.Length(r[From]) - r[count])&_)
in
c
)[[Amount],[ID]],
exp = Table.ExpandListColumn(range, "ID")
in
exp
Добрый день! Хочу добавить значение столбца Name во вложенную таблицу в новый столбец. Пытаюсь так:
Код
Table.TransformColumns(f, {{"tbl", each let n = [Name] in Table.AddColumn(_, "Файл", each n)}})
тут понял, что я n присваиваю уже во вложенной таблицы и она [Name] не видит.
Код
let n = [Name] in Table.TransformColumns(f, {{"tbl", each Table.AddColumn(_, "Файл", each n)}})
так ругается Expression.Error: Неизвестный идентификатор. Использовалось ли условное обозначение [field] для _[field] вне выражения "each"? Я, конечно, могу на более раннем этапе добавить этот Name туда, но просто стало интересно как данной конструкцией это сделать и возможно ли. Если без примера никак, накидаю какой-нибудь.
Друзья, добрый день! Получаю таблицу через Table.Profile(source). Есть столбец Min. Если я прямо через UI в фильтре выберу какое-то значение, то он мне выдаст, что столбца Min нет. -_- А если добавлю вложенный let in (хотя даже никак не буду обращаться к его вложенным шагам), то запрос отработает. Почему так? Ведь обычная таблица же фильтруется, почему эта так не хочет? Спасибо.
Код
let
Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
ChangeType = Table.TransformColumnTypes(Источник,{{"Столбец1", Int64.Type}, {"Столбец2", type any}, {"Столбец3", Int64.Type}, {"Столбец4", Int64.Type}}),
TableProfile = Table.Profile(ChangeType),
НЕ_РАБОТАЕТ = Table.SelectRows(TableProfile, each ([Min] = 3)),
РАБОТАЕТ = Table.SelectRows(TableProfile, each let t = TableProfile in ([Min] = 3))
//РАБОТАЕТ = Table.SelectRows(TableProfile, each let t = "АБРАКАДАБРА" in ([Min] = 3)) и так работает
in
РАБОТАЕТ
Друзья, добрый день! Задача носит образовательный характер, сама она по сути решена, но не всегда получается понять логику функций Accumulate и Generate. Есть текстовый файл, в котором встречаются разрывы строк в неожиданных местах. Как понять, что место неожиданное? В каждой строке должно быть девять штук вертикальных черточек "|". Т.е. если черточек меньше, то объединяем эту строку и следующую. В реальных данных встречал максимум один разрыв строке в одной строке, но для усложнения и универсальности одну из строк разбил двумя разрывами. Помогите, пожалуйста, воспроизвести такую логику через вышеуказанные функции (даже если это не оптимальное решение): - если в строке меньше девяти вертикальных черточек, то объединить ее со следующей - если в полученной после объединения строке все еще меньше девяти черточек, то объединяем со следующей снова - и так пока не закончатся строки У Криса Вебба есть решение по этому вопросу, но там лист объединяется в одно значение как бы, а потом дробится по кол-ву разделителей, мне не особо это подходит и повторюсь, что просто хочется в образовательных целях вопросизвести эту логику.
Рабочее решение через группировку
Код
let
Источник = Table.FromColumns({Lines.FromBinary(File.Contents(path&"Выписка (1).txt"), null, null, 1251)}),
skip = Table.FirstN(Table.Skip(Источник,4),each [Column1]<>""),
filtr = Table.SelectRows(skip, each not Text.StartsWith([Column1], "+")),
f = (x)=>Text.Combine(x[Column1]," "),
// Вот данный шаг gr и хочется воспроизвести через Generate и Accumulate
gr = Table.Group(filtr,
"Column1",
{"tmp",f},
GroupKind.Local,
(s,c)=> Number.From(List.Count(Text.Split(c,"|"))>=10 ))
[[tmp]],
split = Table.SplitColumn(gr, "tmp", Splitter.SplitTextByDelimiter("|"), 10)
in
split
Друзья, добрый день! Как верно было бы решить мою задачу без доп столбца? Table.TransformColumns как-будто не видит второй столбец, подскажите, пожалуйста правильное решение. Если можно, то именно тем путем, каким я пошел, т.е. объединить в таблицу и через Table.TransformColumns и также другим, возможно, боблее правильным способом. Задача чисто теоретическая, на понимаение принципа работы.
Спасибо.
Код
let
lst1 = {"Илья","","",""}, //первый список
lst2 = {"", "Петр","Иван","Евгений"}, //второй список
step1 = Table.FromColumns({lst1,lst2}), //объединяем в таблицу
step2 = Table.TransformColumns(step1,{ //если в первом списке пусто, то взять элемент второго списка,
{"Column1", (x)=> if x is null then [Column2] else x} //иначе оставить элемент первого
}
)[Column1]
in
step2
Друзья, добрый день! Учу PQ, часто надо работать со вложенными таблицами (nested tables). Например, добавить столбец индекса или условный столбец, отфитровать таблицу, преобразовать вложенный список в таблицу. В интернете во всех курсах и туториалах говорят создать настраиваемый столбец, отфильтровать таблицу (или сделать другую манипуляцию), удалить старый столбец, а новый развернуть. Но ведь должен быть способ делать это сразу в том же столбце, чтобы не плоджить шаги. Так вот, нашел, что так можно делать через Table.TransformColumns (в примере шаги Пользовательский1, Пользовательский2, Пользовательский3).
Вложенный List преобразовать в Table
Код
= Table.TransformColumns(#"Добавлен пользовательский объект2",{
{"Пользовательский.2", each Table.FromList(_, Splitter.SplitByNothing())}
}
)
Добавить столбец во вложенную таблицу
Код
= Table.TransformColumns(Пользовательский1, {
{"Пользовательский.2", each Table.AddColumn(_, "День недели", each Date.DayOfWeek(_[Column1]))}
}
)
Фильтрация вложенной таблицы
Код
= Table.TransformColumns(#"Добавлен пользовательский объект3", {
{"Пользовательский.2", each Table.SelectRows (_, each [День недели] = 5)}
}
)
Мой вопрос в следующем, считается ли это хорошей практикой или это скорее костыль? Как было бы правильней эти операции произвести со вложенными таблицами, особенно интересует тема фильтрации вложенной таблицы в том же столбце, без создания нового.
Друзья, добрый день! Подскажите, пожалуйста, почему в результате выполнения следующего кода, у меня возвращается таблица целиком, вместо как задумывается, что в каждой строке должна в новом столбце появиться таблица только со строками, содержащими Город как и город в этой строке. Пример учебный, взял файлик с этого форума, поэтому вопрос не как по-другому лучше, а именно почему не работает именно этим способом.
Код
Table.SelectRows(
#"Добавлен индекс",
each [Город] = #"Добавлен индекс"[Город]{[Индекс]}
)
Друзья, здравствуйте! Считываю тектовый файл в список. В каждой строке списка есть символ "|", по которому в последствии этот список разделяется на столбцы. Их всегда 10, но бывает закрадывается 11-ый. Какое решение вижу с высоты скудного знания PQ: В отдельный столбец вывожу число вхождений символа и если их 11, в этой строке хочу удалить четвертое вхождение этого символа. Подскажите, пожалуйста, как удалить n-ое вхождение некоего символа, в моем случае "|". (вторая строка в приложенном файле, в номере договора указана вертикальная черта) Или если для это применяется другое решение, то подскажите его. Но и по вопросу удаления именно четвертой вертикальной черты тоже подскажите, интересно, как это решается
Друзья, здравствуйте! Во вложении текстовый файл. Разделитель "вертикальная черта". Иногда попадаются такие строки, что они как бы разорваны, т.е. почему-то в строке присутствует перенос строки или что-то (строки в файле примере с NN п/п 160 и 945). По сути, что нужно сделать руками это: 1) посмотреть что строка начинается не с "вертикальной черты" 2) встать в начало этой строки 3) нажать backspace 4) поставить пробел Как подобную логику объяснить Power Query? Нужно именно на нем, не VBA. Спасибо.
Когда жестко прописываю туда путь к файлу, все работает. Преобразовал его в функцию. Вставил аргументом функции путь и имя файла, все работает. При вызове этой функции через пользовательский столбец, выдает ошибку. Какое 4? В какой TEXT? Я специально убрал все преобразования типов из запроса. Файл-пример вроде не требуется, т.к. запрос же с ним работает при сценариях описанных выше.
Цитата
В запросе "" произошла ошибка. Expression.Error: Не удается преобразовать значение 4 в тип Text. Сведения: Value=4 Type=Type
Друзья, добрый день! У меня есть таблица, и есть список названий столбцов. Передаю этот список в Table.SelectColumns, чтобы оставить только необходимые мне столбцы.
Код
= Table.SelectColumns(source, headers)
И все работает нормально, пока в заголовках не появляются кавычки -_-
Ошибка
Что поправить, как их экранировать или что-то, чтобы наличие кавычек не ломало ничего.
Друзья, добрый день! Пытаюсь получить html-код страницы корпоративного портала (помогающие не смогут на него зайти). Если я просто вставляю ссылку в любой из браузеров на рабочем ПК - она открывается. Если через любой из найденных мною кодов в интернете - выдает либо "", либо "401 UNAUTHORIZED" вместо html-кода в Immediate. Как можно обойти такой момент?
Спасибо.
Код
Function GetResponse(ByVal URL$) As String
On Error Resume Next: Err.Clear
Static xmlhttp As WinHttpRequest
If xmlhttp Is Nothing Then Set xmlhttp = New WinHttpRequest
xmlhttp.Open "GET", URL$, True: DoEvents
xmlhttp.send: DoEvents
If Not xmlhttp.WaitForResponse(timeout&) Then
Debug.Print "timeout", URL: Exit Function
End If
GetResponse = xmlhttp.responseText
End Function
Sub test() ' пример использования
On Error Resume Next
txt = GetResponse("http://******.******.ru/_layouts/listform.aspx?PageType=4&ListId={C1A84F4D-04EC-499A-8C4D-69D319B5316C}&ID=27/")
Debug.Print Len(txt) ' возвращает длину текста: 62737 символов
End Sub
Затем нажимаю на таблицу, чтобы ее развернуть: В результате создается такой шаг. Если я правильно понял, то открывается "нулевой" элемент. Если в моем случае имя этой таблицы одинаково всегда, но индекс у него может быть разный, как мне обратиться не по индексу, а по имени? Пробовал так и еще много как...не работает.
Если файл пример будет необходим для этой задачи, постараюсь выложить. Просто с рабочего ПК не очень удобно, а задача, вроде, решается на уровне совета.
Друзья, добрый день! Пытаюсь получить через PQ кодировку файла, чтобы на ее основе применять ту или иную функцию. Открываю файл как XML (во вложении файл) и, облазил все таблицы, которые там открываются, но не нахожу где этот параметр encoding. При этом, открывая файл блокнотом, это первая строчка. Подскажите, почему не нахожу параметр encoding через PQ или как-то по-другому подскажите как через PQ кодировку файла получить.
Добрый вечер, друзья! Есть много файлов, которые выкладывают в сетевую папку, на них повлиять не могу, как они создаются не знаю. Но при открытии вручную выдает следующую ошибку. Если согласиться, то с файлом можно спокойно работать (файл во вложении).
Ошибка 1
И, соответственно, при открытии файла через PQ получаю следующую ошибку.
Ошибка 2
Вопрос: можно ли через PQ открыть данный файл для дальнейшей работы с ним? Как-то игнорировать данное сообщение при открытии. Нужно именно через PQ.
Хочу создать функцию, получения плательщика по номеру договора из закрытого файла, которая будет вызываться с листа (аналог ВПР, получить необходимо только первое значение, даже если оно не одно, сейчас в функции, если значение не одно оно просто красится желтым). Сделал свой вариант через ADO (во вложении, положить оба файла в одну папку, в книге MAIN функция GetPayer). Работает очень долго, в рабочем файле source порядка 100к строк. При каждом вызове функции формируется recordset. Также при каком-либо изменении на листе, связи, я так понимаю, пересчитываются...вообщем пользоваться невозможно. Прошу указать, что мне изменить, чтобы работало пошустрей (если возможен шустрый вариант через ADO, то прошу подсказать в этом направлении). Если по ADO в любом случае тормознуто будет получаться, то какой вариант будет для меня самым быстрым. Возможно, есть какие-то функции, работающие с закрытыми книгами, которые функция просто будет прописывать. Как-то делал нечто похожее, но не из закрытой книги и книга была одна. Здесь мне подсказали сделать Static Dictionary, для первой ячейки словарь формируется какое-то время, зато при протягивании формулы, остальные позиции подтягиваются быстро. Но в данном случае у меня, в рабочей ситуации, файл source не один, их много, файл будет определяться по условию в макросе, не делать же для каждого файла свой словарь. Подскажите, как бы Вы реализовали эту задачу. Благодарен любым советам.
Друзья, добрый день! Решаю такую задачу: для работы макроса необходимо знать, где располагаются определенные элементы на мониторе в данный момент (расположение может быть разное, но в рамках одного цикла работы макроса элементы находятся в одном положении). Для этого хотелось бы, чтобы программа спросила через Inputbox или как-то еще, например, "Щелкните на элементе <плюсик>", пользователь щелкает мышкой на плюсике (либо же наводит на плюсик и нажимает какую-то кнопку, если мышкой нельзя щелкать) и координаты мыши добавляются в переменную, с которой потом уже будем работать.
Нашел такой код:
Код
Код
' Access the GetCursorPos function in user32.dll
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
' Access the GetCursorPos function in user32.dll
Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
' GetCursorPos requires a variable declared as a custom data type
' that will hold two integers, one for x value and one for y value
Type POINTAPI
X_Pos As Long
Y_Pos As Long
End Type
' Main routine to dimension variables, retrieve cursor position,
' and display coordinates
Sub Get_Cursor_Pos()
' Dimension the variable that will hold the x and y cursor positions
Dim Hold As POINTAPI
' Place the cursor positions in variable Hold
GetCursorPos Hold
' Display the cursor position coordinates
MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
"Y Position is : " & Hold.Y_Pos
End Sub
' Routine to set cursor position
Sub Set_Cursor_Pos()
' Looping routine that positions the cursor
For x = 1 To 480 Step 20
SetCursorPos x, x
For y = 1 To 40000: Next
Next x
End Sub
Он отлично работает, встаю мышью куда мне надо, нажимаю F5, получаю координаты. Как это реализовать применимо к описанной выше идее, что это должен быть диалог с пользователем? Нужно какую-то свою форму рисовать? Покажите, пожалуйста, на примере "появилось окно с просьбой указать элемент - я кликаю на элемент - координаты попали в переменную".
Спасибо.
Update: или вот еще какую красоту нашел :-) (если запустить, и таймер бегает и в режиме реального времени координаты отображаются). Как прикрутить, чтобы спрашивало у пользователя кликнуть в точку, у которой нужно получить координаты.
Код
Private Declare Function setcursorpos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal swextrainfo As Long) Private Const mouseeventf_leftdown = &H2 Private Const mouseeventf_leftup = &H4 Private Const mouseeventF_Rightdown As Long = &H8 Private Const mouseeventF_rightup As Long = &H10
Declare Sub sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long Public Type PointAPI x As Long y As Long End Type
Sub MouseMove() Dim lngCurPos As PointAPI Dim startTime As Double Dim SecondsElapsed As Double Dim MinutesElapsed As String
If SecondsElapsed < SecondsToActivate * 0.7 Then Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.7 And SecondsElapsed < SecondsToActivate * 0.8 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 6 Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.8 And SecondsElapsed < SecondsToActivate * 0.9 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 46 Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.9 And SecondsElapsed < SecondsToActivate * 0.95 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3 Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.95 Then If SecondsElapsed Mod 2 <> 0 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3 Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255) End If End If
If SecondsElapsed >= SecondsToActivate Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = xlNone Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) For I = 1 To 500 For J = 1 To 100 setcursorpos x1 + J, y1 Next J For J = 99 To 0 Step -1 setcursorpos x1 + J, y1 Next J Next I
Друзья, добрый день! Получаю по ADO данные из текстовых файлов. Автоматически создается файл schema.ini. Там в строчке "Format = TabDelimited" указываю желаемый разделитель. А как быть, если разделителя два или больше? В приложенном файле разделители табуляция и точка с запятой.
Пока может точку с запятой менять на табуляцию, привести к единому разделителю или есть более красивое решение.
Код
Код
Sub GetDataFromTxtFile(TxtFile As String)
'TxtConn - соединение с БД (в данном случае БД - текстовый файл)
'TxtRs - набор записей Recordset
Dim TxtConn As ADODB.Connection
Dim TxtRs As ADODB.Recordset
'DBPath - путь к БД
'ConnStr - строка подключения к БД
'LastRow - определение последней строки
Dim DBPath As String
Dim ConnStr As String
Dim LastRow As Long
DBPath = ThisWorkbook.Path
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=No;FMT=Delimited';"
Set TxtConn = New ADODB.Connection
Set TxtRs = New ADODB.Recordset
TxtConn.ConnectionString = ConnStr
TxtConn.Open
'закрыть соединение в случае ошибки
On Error GoTo CloseConnection
With TxtRs
.ActiveConnection = TxtConn
'SQL-запрос к БД
.Source = "SELECT * FROM " & "[" & TxtFile & "] " & ""
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
'закрыть Recordset в случае ошибки
On Error GoTo CloseRecordset
'последняя заполненная строка по столбцу "А"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'вставляем Recordset ниже последней заполненной строки
Range("A" & LastRow + 1).CopyFromRecordset TxtRs
'отключаем обработку ошибок
On Error GoTo 0
CloseRecordset:
TxtRs.Close
CloseConnection:
TxtConn.Close
End Sub
Друзья, добрый день! Подскажите, пожалуйста, хотелось бы, чтобы в случае увольнения определенного сотрудника, макрос переставал работать. Сейчас сделал такое в начале процедуры:
Код
If (Int(CDbl(Date)) - Int(CDbl(#7/31/2021#))) > 90 Then Exit Sub
Т.е. через 90 дней перестанет работать, если я вручную дату не подправлю. Но хотелось бы красивого, универсального решения.
Как я это предполагаю должно работать: у сотрудника есть почтовый адрес, пусть будет IvanovBO@company.ru. Если сотрудник уволен, то у него в Outlook будет такое: Можно ли как-нибудь к этому привязаться? Чтобы при открытии книги, проверялось, жива ли почта. Если нет, то End Sub.
Либо еще такой вариант, есть корпоративный портал, где если вписать ФИО сотрудника, получаем по нему информацию. Если уволен, то будет "найдено 0 сотрудников" соответственно.
Портал
Или принимаются другие решения по данному вопросу, может я не туда думаю
Друзья, добрый день! Сразу оговорюсь, что вопрос не в том как лучше получить данные из текстового файла (понимаю, что есть куча более удобных способов), а просто конкретный вопрос по проблеме с кавычками. Пробую освоить recordset, получаю данные из txt файла. Но если в строке есть двойные кавычки (вот такие ", причем вот с такими « отрабатывает нормально), то строка как бы режется и данные из других колонок для этой строки я вообще не получаю. Как это можно обойти? (Для желающих помочь, текстовый файл должен находиться в той же папке, где xlsm файл.)
Код
Код
Sub SQLfromTXT()
Dim rs As New ADODB.Recordset
DBPath = ThisWorkbook.Path ' в этой папке находится файл txt, являющийся БД.
CnnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=NO;FMT=TabDelimited(|)'"
SQLString = "SELECT * FROM 10703Rst.txt"
rs.Open SQLString, CnnStr
With ThisWorkbook.Worksheets(1)
.Cells(1, 1).CopyFromRecordset rs
End With
End Sub
Пример текстового файла, проблемные кавычки отмечены желтым
Результат, выгруженный на лист. Видно, что все, что идет после кавычек, пропало.
Друзья, добрый день! Как можно получить данные из текстового файла через SQL запрос из VBA (например всю таблицу Select * From Table)? Погуглив, нашел, что это делается через recordset, но чтение теории не помогло, а примеры везде приводятся сильно усложненные. Более-менее простой пример попробовал приспособить, но у меня ошибка на строчке Debug.Print rs.Fields("Город").Value. Помогите, пожалуйста, максимально простым примером подключения к текстовому файлу (понимаю, что есть куча других способов получить данные, но здесь чисто образовательный интерес по этому способу, а не какая-то практическая задача)
Спасибо.
Найденный код
Код
'Option Explicit
Public Sub test()
'Connection - соединение с базой даннных
'Command - команда DML
'Recordset - набор записей
'Stream - поток двоичных или текстовых данных
'Record -Запись
'нужно подключить библиотеку Microsoft ActiveX Data Object 2.x Library
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
'Source=c:\ - директория, где хранится файл
'HDR = YES указывает, что первая строка содержит columnnames, а не данные, HDR = NO; свидетельствует об обратном
'cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\valek\Desktop\БД\БДtxt.txt;Extended Properties=""text;HDR=YES;FMT=Delimited"""
'открыть соединение с базой данных
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\valek\Desktop\БД\;Extended Properties=""text;HDR=YES;IMEX=1;"""
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'имя файла к которому идёт обращение "С_помощью_ADO_и_SQL_опрашивать_текстовые_файлы.txt", разделить - ";"
rs.Open "select * from [БДtxt.txt]", cn
Debug.Print rs.Fields("Город").Value
'Debug.Print rs.Fields("Name").Value
'Debug.Print rs.Fields("Price").Value
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Друзья, добрый день! Имею код, который вставляет картинку в документ WORD.
Код
pngFile = ActiveWorkbook.Path & "\печать.png"
Set p = objWrdDoc.InlineShapes.AddPicture(pngFile, False, True, objRange)
Хочется, чтобы картинка хранилась в этом же файле, а не хранить ее отдельно. Как мне правильно обратиться к этой картинке? В файле примере эта картинка на "Лист2", имя "Печать". Или может заодно посоветуете как-то по-другому ее хранить в файле для удобства.
Друзья, добрый день! Можно ли средствами VBA разблокировать компьютер, после того как заблокировал его клавишами WIN+L (естественно, зная пароль)? Скажем, через 5 минут после блокировки.
Друзья, добрый день! Пытаюсь подключиться через PQ к сайту asos.com и привести к табличному виду полученную с него информацию. Но у меня просто идет бесконечное подключение к сайту, через какое-то время сообщение "Проищошла ошибка при попытке подключения. Подробности: "Базовое соединение закрыто: Соединение было неожиданно закрыто."". Делаю просто Данные -> Из интернета -> Вставляю ссылку Пример ссылки, к которой подключаюсь: https://www.asos.com/ru/men/a-to-z-of-brands/nike/cat/?cid=4766&ctaref=hp|mw|prime|logo|10|nike
Объясните не сильно разбирающемуся человеку, что здесь не так? К сайту с какими-то котировками подключается без проблем. Какой-то хитрый сайт я выбрал? Спасибо.
Друзья, доброго времени суток! Подскажите, пожалуйста, как с помощью VBA скачать выписку по ИНН (например, 622702133220), имея его в ячейке A1? Посмотрел в интернете, наткнулся на способ с имитацией нажатий кнопок в браузере (открыть сайт - ввести ИНН - нажать "поиск" - нажать "скачать выписку"), но даже так не смог разобраться. (есть Chrome и IE) Или может есть какой-то способ скачать файл напрямую, без нажатий. Затем планирую скачивать так выписки массово по списку ИНН, но уж цикл то думаю смогу прикрутить)
Друзья, добрый день! Как в PQ реализовать аналог "замены со звездочкой"? Т.е. в Excel я делаю, например в строке "ККК 3465345345 договор за бла бла Иванов бла бла Петров" замену [" договор*"] на [""] и имею только номер договора. В PQ так не срабатывает. До этого делал разбивку по столбцам по этому слову и удалял ненужный столбец, но когда таких слов для замены много, то так не очень удобно. Примерный список слов, которые буду так менять в файле примере, но он неполный, т.к. может пополняться. Привязаться к номеру договора и просто его вычленять из столбца, думаю, что не получится, т.к. его люди вводят от руки и какую-то универсальную маску задать не выйдет. Договор всегда первым идет в ячейке, в нем как могут быть пробелы, так может и не быть.