Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA (часть 3)

Автор: akellaks
Дата сообщения: 10.09.2015 06:58
Мне нужно вытащить таблицу с сайта в данном файле указана страница профиль, это для примера, пароль там установлен временный
скрип работает и просто авторизируется на сайте, но проблема что через получить данные из интернета, эта авторизация не передается
и если сам ввел логин и пароль то все работает отлично, а авторизация от макроса не передается
можете подсказать как можно авторизацию передать в получить данные из интернета

или где можно взять скрипт на получение данных из таблицы на сайте с авторизацией

сайт в данном скрипте чисто для примера, таблиц там нет
у меня сайт внутрисетевой с таблицами на разных страницах

пожалуйста можете дать совет или подсказку
вот что у меня получилось
https://yadi.sk/d/kYdz4HBuiyj26
Автор: idiMAN
Дата сообщения: 10.09.2015 07:41
akellaks
Как вариант, можно попробовать выкачать нужную таблицу с помощью wget или curl (они позволяют задать логин и пароль), а затем уже цеплять её как обычную локальную таблицу.

А по поводу авторизации, можно попробовать так:
http://195.162.32.8:8080/x4/index.php?username=твой_логин&password=твой_пароль
Только слова "username" и "password" в твоём случае могут быть другими.

Вообще посмотри что передаётся между твоим компьютером и данным сайтом с помощью fidler или хотя бы нажав "F12" и далее "Сеть" в IE11 или "Ctrl+Shift+I" -> "Network" в Google Chrome
Автор: Alex_Piggy
Дата сообщения: 10.09.2015 08:23
Доброе время, akellaks
Залогинились, а теперь ищете таблицу и пробуете вставить через Clipboard. Что-то вроде такого (если URL - в переменной MyURL2, а таблица имеет id TABLEID)

Код:
MyBrowser.Navigate MyURL2
Do: DoEvents :Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
Set oTable = HTMLDoc.all.Item("TABLEID")
Set Clip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' Или "Set Clip = New DataObject"
Clip.SetText "<html>" & oTable.outerHTML & "</html>"
Clip.PutInClipboard
ActiveSheet.Range("A1").Select
ActiveSheet.PasteSpecial
Автор: akellaks
Дата сообщения: 10.09.2015 09:24
1
Автор: idiMAN
Дата сообщения: 10.09.2015 12:33
akellaks
Тут очень близко к Вашему случаю... Но нужно "допиливать"
Автор: Futurism
Дата сообщения: 23.09.2015 15:44
помогите, пожалуйста, написать макрос, который удаляет из блокнота цифры
например
40, текст
25, текст1
надо удалить именно эти цифры слева до запятой
чтобы было
, текст
, текст1
Сам блокнот по пути D:/folder
Автор: I95
Дата сообщения: 23.09.2015 16:25
Futurism, немого офтоп но,
Если пользуетесь тотал коммандером, то может быть Вам понравится другой вариант решения Вашей задачи с помощью утилиты TCIMG.
Например такой доп кнопкой Вы удаляете все цифры из текстового файла под курсором (как один из вариантов решения)
[more]

Код: TOTALCMD#BAR#DATA
%COMMANDER_PATH%\TCIMG\TCIMG.exe
textt=%P%N||&&\d!!||upd<6>
%COMMANDER_PATH%\Wcmicons2.dll,103
Удаляем все цифры из файла под курсором


-1
Автор: Futurism
Дата сообщения: 24.09.2015 14:32
ок, я попробую) просто на работе нет ТС))
Автор: kindtime
Дата сообщения: 02.10.2015 15:41
Здравствуйте, помогите пожалуйста, мне облегчить задачу. Вот здесь эксель файл:
http://rghost.ru/8kgVmxNb6
Тут мы видим, что у нас есть 7 переменных: x1-x7,желтое поле и для каждой переменной после него есть 3 переменных.
Например, для переменной Х1, есть 3 переменных х1,х1,х1
для переменной Х2, есть 3 переменных х2,х2,х2. и так далее. Для образца я просто написал для 4х переменных.
Нужно переструктурировать данные.
Сначала идет желтое поле (сколько бы колонок в нем не было) - потом- переменная х1-а потом ровно 3 переменных x1,x1,x1

затем тоже самое.
желтое поле(оно всегад статично)-переменная х2- и за ней 3 переменных x2, x2,x2.
Переменных у меня сотни в работе, но есть строгий порядок их следования, его нельзя нарушать.
Кому нетрудно помогите написать макрос, который эту механическую работу облегчает.

Автор: Ivan38Rus
Дата сообщения: 06.10.2015 10:25
Добрый день.

Господа, есть задача в сращивании нескольких книг в одну непрерывную структуру.

Есть готовый макрос, найденный на просторах интернета, который с этой задачей справляется, но есть необходимость "обрезать" первую строку (заголовки столбцов) в каждой сращиваемой книге. Помогите, пожалуйста, доработать данный скрипт.


Код: Sub FiziK()

Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат
Const blInsertNames = True 'вставлять строку заголовка (книга, лист) перед содержимым листа

Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
i As Integer, stbar As Boolean, clTarget As Range

On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application 'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Join files", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
.ScreenUpdating = False
stbar = .DisplayStatusBar
.DisplayStatusBar = True

For i = 1 To UBound(arFiles)
.StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
For Each shSrc In wbSrc.Worksheets
If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
'If blInsertNames Then
'clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name
'Set clTarget = clTarget.Offset(1, 0)
'End If
shSrc.UsedRange.Copy clTarget
End If
Next
wbSrc.Close False 'закрыть без запроса на сохранение
Next
.ScreenUpdating = True
.DisplayStatusBar = stbar
.StatusBar = False

On Error Resume Next 'если указанный путь не существует и его не удается создать,
'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Result", "Excel Files (*.xlsx), *.xlsx", , "Save book")

If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
GoTo save_err
Else
On Error GoTo save_err
wbTarget.SaveAs arFiles
End If
End
save_err:
MsgBox "Book was not saved", vbCritical
End With
End Sub
Автор: Winand
Дата сообщения: 08.10.2015 15:07
Может лучше их все лучше в пдф перевести, чем один суперлист в экселе:-D
Автор: Futurism
Дата сообщения: 21.10.2015 13:44
Подскажите , плиз. как значения в желтый ячейках сделать абсолютными.
Например
A1-B1=-3 ячейки с такими результатами помечены желтым.
можно бы сделать так (A1-B1)*-1=3 но тут много таких желтых ячеек и она разбросаны по всему листу.
Можно ли этот процесс как-то автоматизировать?

PS: сорри вопрос снимаю ,сам допер))
Автор: JekG
Дата сообщения: 04.11.2015 21:04

подскажите как макросом посчитать такую штуку - в первом столбце сплошные цифры, во втором - с промежутками. нужно правее каждой заполненной ячейки второго столбца разместить автосумму значений из первого столбца которые находятся правее и выше этой заполененной ячейки из второго столбца. промежутки между заполненными значениями во втором стобце могут быть разные.
Автор: KDPoid
Дата сообщения: 06.11.2015 07:28
В ячейке B4 должно быть 33 или 35 ?

"подскажите как макросом посчитать" - это идея не понятна или какой-то конкретный затык ?
Ну... пройтись циклом по строкам.
Значения из столбца А складывать.
Если в B не пусто, выкладывать туда накопленную сумму. В зависимости от требований, или сбрасывать при этом накопленную сумму, или нет.

Если сформулировать конкретный вопрос: "Не знаю как сделать ля-ля.", тогда больше шансов получить в ответ "Ля-ля делается так:..."
Автор: mrdime
Дата сообщения: 06.11.2015 12:48
Господа,
Иногда попадаются старые файлы (в формате .xlsx кстати тоже) которые при попытке их закрытия (когда никаких изменений не вносилось) выдают сообщение типа "вы хотите сохранить изменения да/ нет".
Почитал много литературы, но как ни пытался добиться отключения этого окна не смог.
Какие бы изменения я не вносил в мой файл PERSONAL.XLSB, они не влияют на закрытие проблемных файлов.
Использовал события Workbook_BeforeClose и Workbook_BeforeSave
Пробовал следующие варианты:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
End Sub
__
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close False
Application.DisplayAlerts = True
End Sub
__
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Saved = True
End Sub
__
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If (SaveAsUI = True) Then
Cancel = True
End If
End Sub
__
Этот вариант (тоже предлагался) сохранить не смог, т.к. сабж его не сохраняет (хотя не думаю, что он бы сработал)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub
__
В то же время ВСЕ эти варианты работают, если их прописать в сам проблемный файл.
Но, это не вариант, т.к. файлов много, да и нельзя предсказать, когда они попадутся.
Задача - создать макрос в файле макросов PERSONAL.XLSB, который бы предотвращал вывод назойливого окна с запросом "вы хотите сохранить изменения да/ нет"/ "Want to save your changes to...?" для любых файлов.
Автор: Klisha
Дата сообщения: 12.11.2015 00:34
Коллеги, подскажите плиз.
Изрыл весь инет.. не нашел решения, но знаю что где-то видел...
Имеется книга с адским количеством листов (порядка 150) листы формируются автоматически, в каждом листе может быть таблица в несколько десятков страниц.
Необходимо одним махом отправлять эту книгу на печать (или любые выделенные листы) и так чтобы каждый лист печатался с колонтитулом "Страница x из y", где y - число страниц в данном листе. Колонтитулы в лист соответствующего содержания вставлены. Вот только при выделении множества листов и отправки их на печать y - общее количество страниц на всех выделенных листах.
Как решить эту проблему?
Автор: Drean
Дата сообщения: 23.11.2015 17:08
Прошу помочь с макросом. Мне нужно чтобы все ячейки типа R на каждом следующем листе имели значение +1 от существующего (R[45] , R[39] , R[36] , R[37]). Столбы постоянные на всех листах. Таких листов 200. нужно запустить макрос, чтобы на все листы распространилась такая информация (+1 по строке).



Цитата:
Sub Макрос6()
'
' Макрос6 Макрос
'

'
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[45]C[2]"
Range("G13").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[39]C[-3]"
Range("C16").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[36]C[2]"
Range("A15:H15").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[37]C[5]"
Range("A16:B16").Select
Sheets("1 (50)").Select
ActiveWindow.SmallScroll Down:=-33
Range("A7:H7").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[46]C[2]"
Range("G13").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[40]C[-3]"
Range("C16").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[37]C[2]"
Range("A15:H15").Select
ActiveCell.FormulaR1C1 = "='Реестр собственников П1'!R[38]C[5]"
Range("A16:B16").Select
End Sub


В этом макросе на двух листах сделано то, что нужно распространить на все 200.
Автор: KDPoid
Дата сообщения: 25.11.2015 14:34
В вашем макросе заполнение текущего листа, потом переключение на лист "1 (50)" и заполнение его.

Есть какая-то логика в наименовании или расположении листов ?

Можно утверждать, что "Реестр собственников П1" - всегда первый лист ?

200 листов, которые надо заполнить - это листы со второго по 201-й или их нужно идентифицировать по имени ?

Добавлено:
Если все мои предположения верны, то вот:

Код:
Sub qweqwe()
For i = 2 To 201 ' Цикл по листам. Все 200 должны быть.
Application.Sheets(i).Range("A7:H7").FormulaR1C1 = "=''Реестр собственников П1'!R[" + CStr(43 + i) + "]C[2]"
Application.Sheets(i).Range("G13").FormulaR1C1 = "=''Реестр собственников П1'!R[" + CStr(37 + i) + "]C[-3]"
Application.Sheets(i).Range("C16").FormulaR1C1 = "=''Реестр собственников П1'!R[" + CStr(34 + i) + "]C[2]"
Application.Sheets(i).Range("A15:H15").FormulaR1C1 = "=''Реестр собственников П1'!R[" + CStr(35 + i) + "]C[5]"
Next i
End Sub
Автор: Fsp050
Дата сообщения: 27.11.2015 17:27
Помогите, пожалуйста на VBA написать один скрипт, который генерирует значения по определенным условиям:
Например
Пусть есть переменные и их значения a,b,c
пол X1,X2,X3
м a a a
ж b b b
ж c c c
Нужно сгенирировать значения, но так, чтобы соблюдались пропорции только в случайном порядке:
например 30% мужчин в переменной X1 поставили ответ а, 40% мужчин поставили ответ b и ещё 30% мужчин поставили ответ с
при этом
20% женщин в переменной X1 поставили ответ а, 65% женщин поставили ответ b и ещё 25% женщин поставили ответ с
Аналогично и с другими переменными, их может быть несколько.

Надо просто чтобы в самом годе было написано
пол=200 человек
переменная x1, пусть имеет пять градаций а,б,в,г,Д
градация а=5%мужчин, 25%женищин.
градация б=10% мужчин и 45% женщин
...

Помогите, плиз такое сделать.
Автор: lsd11
Дата сообщения: 03.12.2015 09:55
уважаемые гуру, есть проблема.
существует некий массив данных вида
http://s020.radikal.ru/i717/1512/3d/1cbb18cd6037.jpg
В котором периодически дублируются строки, если контрагент купил что-то другого цвета или иного свойства.
Может быть и 3-4 таких строки, теоретически.
Т.е. продажи суммируются, данные дублируются но в поле цвет стоит имя доп.цвета.
Задача:
имя доп.цвета (или другого доп.свойства) записать в новое поле основной строки, можно через какой-то разделитель, дубликаты строчки удалить.
Как почистить массив максимально автоматизировано, чтобы максимально без человеческого фактора? Всю голову себе сломал.
Автор: DJMC
Дата сообщения: 04.12.2015 12:58
подскажите можно ли сделать из строк (их свыше 1000) фильтрацию по каждому событию из 15? :


Цитата:
50;1-(1);2-(1);3-(1);4-(1);5-(1);6-(1);7-(X);8-(1);9-(1);10-(X);11-(1);12-(X);13-(2);14-(1);15-(1).
50;1-(1);2-(1);3-(1);4-(1);5-(1);6-(1);7-(X);8-(1);9-(1);10-(X);11-(2);12-(2);13-(2);14-(1);15-(1).
Автор: KDPoid
Дата сообщения: 08.12.2015 13:46
lsd11, волшебный макрос квекве спасёт тебя

Код:
Sub qweqwe()
i = 3 ' Начинаем с третьей строки. В первой заголовки, а второй не с чем совпадать.
While ActiveSheet.Range("A" + CStr(i)) <> "" ' Проверяем строки, пока в первом столбце что-то есть
If ActiveSheet.Range("A" + CStr(i)) = ActiveSheet.Range("A" + CStr(i - 1)) Then ' Если значение столбца A совпадает со строкой выше
ActiveSheet.Range("G" + CStr(i - 1)) = ActiveSheet.Range("G" + CStr(i - 1)) + "/" + ActiveSheet.Range("G" + CStr(i)) ' Добавим значение столбца G наверх через разделитель
Rows(i).EntireRow.Delete ' удалим текущую строку
Else
i = i + 1 ' Если не совпало, переходим к следующей строке
End If
Wend
End Sub
Автор: lsd11
Дата сообщения: 09.12.2015 07:56
KDPoid,
спасибо огромное!
Буду пользоваться
Автор: mrdime
Дата сообщения: 10.12.2015 17:48
Всем привет.
Подскажите код для сортировки массива строк по алфавиту.
Нашел вариант сортировки, основанный на методе "пузырёк" (http://www.cyberforum.ru/vba/thread222888.html), но что-то он не совсем грамотно сортирует: первые буквы - ок, а вторые - уже как повезет. Хотелось бы что-то более корректно сортирующее.
Автор: KDPoid
Дата сообщения: 11.12.2015 14:21
mrdime,
Вам, в целях обучения, нужно продемонстрировать преподавателю, что вы можете на VBA написать сортировку ?

Я к тому, что если нужен результат, а не процесс... То сортировку проще доверить Excel-у...
У него голова железная, пусть он и сортирует

Код:
Sub qweqwe()
With ActiveSheet.Sort
.SetRange Range("A5:A12") ' диапазон сортировки
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Автор: mrdime
Дата сообщения: 11.12.2015 14:33
KDPoid

Цитата:
Вам, в целях обучения, нужно продемонстрировать преподавателю, что вы можете на VBA написать сортировку ?

Все намного сложнее. У жены на работе таблица в Excel, куда забиваются люди (фамилии, имена, должности). Таблица хитрым образом обрабатывается и выводится в документ Ворд (конечный документ нужен в Ворде). Точнее - люди выводятся "порциями" по несколько человек (по специальностям/ должностям), каждую из которых надо сортировать в алфавитном порядке (фамилии).
В Excel сортировать не годится, т.к. таблица должна оставаться без изменений (люди вносятся в порядке поступления по датам).
В принципе в алгоритме (коде) который у меня есть все устраивает, проблемы возникают с нестандартными кирилличными символами (в дан. случае - укр. языка). Если фамилия содержит (а особенно - начинается) на такой символ, такие фамилии сортируются не по алфавиту, а идут почему-то в начале. В общем если коротко - то проблема с сортировкой фамилий (значений массива), содержащими спец. кирилличные символы.
Автор: KDPoid
Дата сообщения: 11.12.2015 14:59
Если вас устраивает код по ссылке, то реализованный там пузырёк будет странновато вести себя из-за:

Код:
If Asc(UCase(Массив(i - 1))) > Asc(UCase(Массив(i))) Then
vВременный = Массив(i - 1)
Массив(i - 1) = Массив(i)
Массив(i) = vВременный
End If
Автор: mrdime
Дата сообщения: 11.12.2015 19:30
KDPoid
Спасибо подход, понятен и решение оч. хорошее.
Но при дальнейших экспериментах с кодом (по указанной выше ссылке), я увидел, что кроме проблем со спец. кирилличными символами есть проблема и в самом подходе.
Встроенная функция Asc() вовращает код лишь первого символа в из переменной Массив (i), т.е. если встречается несколько человек, фамилии которых начинаются на одну букву, то в сортировке необходимо анализировать вторую, а при необходимости - третью и т.д. букву (если первые 2 совпадут). Данный код этого не может сделать, соответственно люди с похожими началами фамилий располагаются как попало.
Я несколько изменил подход, вместо сложной конструкции
Цитата:
If Asc(UCase(Массив(i - 1))) > Asc(UCase(Массив(i))) Then
, скормил Екселю упрощенный вариант, т.е.
Цитата:
If UCase(Массив(i - 1)) > UCase(Массив(i)) Then

Не знаю, как Ексел или VBA (в данном случае) это обрабатывает, но сортировать начал абсолютно грамотно, т.е. учитывать все символы в процессе сравнения. Думаю, сравнение тоже базируется на кодах ASCI, только как-то комплексно (т.е. перебирая все символы).
НО, при этом проблема со спец. кирилличными символами осталась (фактически - это одна украинская буква "І", т.к. на другие спец. буквы обычно фамилии не начинаются.) Если фамилии начинаются на эту букву, такие элементы массива сабж бросает в начало списка (очевидно потому, что эта буква имеет код ASCI 178, т.е. меньше, чем у всех других букв алфавита). Поскольку от функции сравнения с использованием функции Asc(), я ушел, то и использование пользовательской функции MyAsc(), тоже уже не сработает.
Соответсвенно вопрос остается открытым: как правильно отсортировать элементы массива с учетом вышеописанной проблемы со спец. символами (буквой "І")?
Интересует сам принцип решения проблемы, а не конкретный символ, т.к. в русском это может быть буква "Ё" например при сортировке фамилий.
Автор: KDPoid
Дата сообщения: 11.12.2015 19:54
Следующий вариант...

Код:
Sub qweqwe()
Range("A1:A10").Select ' выделяем диапазон, который хотим перенести.
Selection.Copy ' копируем
Range("Z1").Select ' переходим на чистое место.
ActiveSheet.Paste ' вставляем.
With ActiveSheet.Sort ' сортируем привычным способом
.SetRange Range("Z1:Z10")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With

' Где-то тут переносим в Word

Range("Z1:Z10").Select ' прибираемся за собой.
Selection.ClearContents
End Sub
Автор: mrdime
Дата сообщения: 14.12.2015 18:26
KDPoid

Цитата:
Следующий вариант...

Спасибо за код. Если честно, то мне не особо нравится что-то куда-то копировать, потом, удалять. Хотелось бы сделать это все внутри кода... это с т. зрения красоты и эстетичности. А если с позиции "главное, чтобы работало", то вроде бы ок. Потестирую, посмотрю что будет лучше по юзабельности: новый вариант или существующий с проблемной буквой "І" (фамилий не особо много, начинающихся на "І"): можно каждый раз проверять начало полученных таблиц в Ворде и руками переносить нужные куски на место.

Раскопал еще "клондайк" с разными решениями сортировки массивов (цифровых и текстовых) в vba (но на английском) + там надо разбираться (на что сейчас времени нет). Кому интересна эта тема (для себя), можете посмотреть:
http://stackoverflow.com/questions/152319/vba-array-sort-function
Если когда-то допилю код, то здесь отпишусь. Думаю, что проблема будет актуальна в любом языке, основанном на кириллице.

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127

Предыдущая тема: VS 2010

Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.