Alcochemist

Alcochemist

пикабушник
поставил 16933 плюса и 112 минусов
отредактировал 2 поста
проголосовал за 6 редактирований
12К рейтинг 10 подписчиков 888 комментариев 14 постов 6 в горячем
87

VBA Excel - вывести формулы в ячейки

Была задача по переносу вычислений из экселя. Чтобы не лезть и не смотреть формулу в каждой ячейке я написал небольшой макрос, который их выводит.

Ниже выделенного диапазона на 10 строк выводятся все формулы и значения из заполненных ячеек.

Получается вот такая штука, которую гораздо проще разобрать и перенести

VBA Excel - вывести формулы в ячейки Excel, Vba, Макрос

Сам макрос:

Sub DrawFormulas()
For Each Cell In Selection
CellFormula = Cell.Formula
If Left(CellFormula, 1) <> "=" Then CellFormula = "=" + CellFormula
If Trim(CellFormula) <> "=" Then Cell.Offset(Selection.Rows.Count + 10).Value = Cell.Address + CellFormula
Next
End Sub

58

VBA Excel - массовая безопасная замена

Решил поделиться ещё одним полезным отрывком кода. Была задача массовой замены в документе одних значений на другие, при этом они могли пересекаться (изменилась нумерация) и обычная последовательная замена приводила к хаосу. В результате получилась вот такая процедурка для замены в 2 прохода.

Sub SafeReplace(TargetRange As Range, ReplaceRules As Range)
' безопасный массовый поиск и замена
' TargetRange: где ищем, ReplaceRules: правила замены, первый столбец - что найти, второй - на что заменить
For i = 1 To ReplaceRules.Rows.Count ' for each
TargetRange.Replace _
What:=ReplaceRules.Cells(i, 1), Replacement:="!SafeReplace" + CStr(i) + "!", _
MatchCase:=False
Next ' замена 1 проход
For i = 1 To ReplaceRules.Rows.Count ' for each
TargetRange.Replace _
What:="!SafeReplace" + CStr(i) + "!", Replacement:=ReplaceRules.Cells(i, 2), _
MatchCase:=True
Next ' замена 2 проход
End Sub
с форматированием - на pastebin.com

Пример использования: на вкладке ReplaceRules есть таблица замены

VBA Excel - массовая безопасная замена Excel, Vba, Замена

Для замены в выделенном фрагменте используем следующий макрос, привязанный на горячую кнопку.

Sub ReplaceSelected()
Application.ScreenUpdating = False
Dim ReplaceRulePos As Range
Set ReplaceRulePos = Worksheets("ReplaceRules").Range("A1").CurrentRegion.Offset(1, 0) ' смещение на 1 строку, без заголовка
Call SafeReplace(Selection, ReplaceRulePos.Resize(ReplaceRulePos.Rows.Count - 1)) ' изменить размер области, чтобы последний пустой ряд не обрабатывался и вызвать автозамену
Application.ScreenUpdating = True
End Sub
45

VBA Excel - выбор документа для обработки

Несколько раз была задача, когда изменения надо вносить не в текущий документ, а в документ с неизвестным именем. В результате получилась вот такая форма:

VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост

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

К сожалению, эксель не экспортирует формы в текстовом виде (во всяком случае, 2007 точно нет), поэтому будут скрины контролов и их свойств.

VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост
VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост
VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост
VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост
VBA Excel - выбор документа для обработки Excel, Vba, Длиннопост

Как вы видите, я не заморачивался с названиями.

Код:

Public SrcName

Private Sub CommandButton1_Click()

SrcName= ""

If ListBox1.ListIndex >= 0 Then

SrcName= ListBox1.List(ListBox1.ListIndex)

UserForm1.Hide

End If

End Sub

Private Sub CommandButton2_Click()

SrcName= ""

UserForm1.Hide

End Sub

Private Sub OpnButton_Click()

iOpen = Application.Dialogs(xlDialogOpen).Show

If iOpen = True Then

SrcName= ActiveWorkbook.Name

UserForm1.Hide

Else

MsgBox "отмена", vbCritical, ""

Exit Sub

End If

End Sub

Private Sub UserForm_Activate()

SrcName= ""

ListBox1.Clear

NoShow = ThisWorkbook.Windows(1).Caption

For i = 1 To Application.Windows.Count

If Application.Windows(i).Caption <> NoShow Then ListBox1.AddItem (Application.Windows(i).Caption)

Next ' enum windows

End Sub

Пикабу сожрал все отступы, это не я!

Пример использования:

Dim SrcWB As Worksheet
UserForm1.Show
If UserForm1.SrcName= "" Then Exit Sub
Windows(UserForm1.SrcName).Activate
Set SrcWB = ActiveWorkbook

P.S. Баянометр считает, что эксель на 41% похож на клубничку. Мне кажется, что он недалёк от истины.

Показать полностью 5
8

Мощный батут против автомобиля и катера

Что происходит, когда бывший инженер НАСА встречается с людьми, которы творят дичь?

Они начинают творить дичь на научной основе!

Ребята с канала "How Ridiculous" любят сбрасывать всякую хе хрень с высоты на батут. Однажды, после того, как они сломали очередной батут, скинув на него шар в 90 кило, они решили найти человека, который смастерит трамплин попрочнее. И этим человеком стал Марк Робер.

Сам момент падения катера на 13 минуте

А вот тут автомобиль, кто не хочет смотреть всё - вам нужно время 11:33

9264

Как осложнить жизнь фишинговому сайту

Пришло сообщение от знакомой, в несвойственной ей манере.

Как осложнить жизнь фишинговому сайту Обман, Мошенничество, Фишинг, Javascript, Длиннопост

Явно отвечает робот.

Сайт ведёт на сгенерированную страницу, где даже текст изображением. Ссылки ведут на фейковую страницу авторизации.

Как осложнить жизнь фишинговому сайту Обман, Мошенничество, Фишинг, Javascript, Длиннопост

Ну а раз отвечает робот, то, скорее всего, автоматизировано всё.

Теперь берём, и с помощью консоли смотрим, какие поля и куда он отправляет.

Как осложнить жизнь фишинговому сайту Обман, Мошенничество, Фишинг, Javascript, Длиннопост
Как осложнить жизнь фишинговому сайту Обман, Мошенничество, Фишинг, Javascript, Длиннопост

Исходя из этих данных на скорую руку пилится вот такой скрипт (выражаю тут благодарность создателям и пользователям stackoverflow, c которого я невозбранно попячил пару функций):


function pass_gen(len) {
chrs = 'abdehkmnpswxzABDEFGHKMNPQRSTWXZ123456789';
var str = '';
for (var i = 0; i < len; i++) {
var pos = Math.floor(Math.random() * chrs.length);
str += chrs.substring(pos,pos+1);
}
return str;
}
function submitForm(oFormElement)
{
var xhr = new XMLHttpRequest();
xhr.onload = function(){ console.log(xhr.responseText); }
xhr.open(oFormElement.method, oFormElement.getAttribute("action")||document.URL);
xhr.send(new FormData(oFormElement));
return false;
}
setInterval(function() {
document.querySelector('#data1').value = pass_gen(5 + 15 * Math.random()) + '@Mail.ru';
document.querySelector('[type="password"]').value = (pass_gen(8 + 10 * Math.random()));
submitForm(document.querySelector('#login_submit'));
}, 500);

Что тут происходит: каждые 500мсек (0.5 секунды) генерится рандомный e-mail на мылору и рандомный пароль, а после этого отправляется на сервер. Запускаю скрипт в консоли и надеюсь, что никакого антифлуда не предусмотрено.

Ожидаемый результат: засирание базы мэйлов и паролей, в которой будет туча фейковых данных, нагрузка на сервак, увеличение количества отлупа авторизаций (что может привести к бану со стороны ВК).

Показать полностью 3
7

Билайн и смена тарифа

Хотя ситуация уже разрешилась, но до сих пор АШТРИСЁТ.

TL/DR: Не повторяйте моих ошибок, меняйте тариф близко к концу оплаты текущего.

Решил я поменять в пчелайне тариф на менее дорогой, такое количество минут уже не требовалось. Поменял я его (вроде бы) ещё дней 10 назад, но то ли у меня ручки кудрявые, то ли ещё что, но тариф не поменялся.

Сегодня была списана оплата за старый тариф, я удивился, проверил что тариф старый и решил поменять ещё раз. Позвонил в поддержку, следов смены тарифного плана не нашли и предложили поменять сейчас. Я радостно отказался от ещё более затратного тарифа и подключил тот, который хотел.

А вот теперь самая мякотка, из-за чего у меня бомбануло. Тариф подключается сразу и то, что я заплатил по старому тарифу, считается что услуга оказана, даже если были только входящие сообщения/смс. Оплаченный пакет минут и трафика по старому тарифу просто испаряется и начинает списываться плата по новому тарифу. Соответственно, я буквально подарил оплату за месяц, т.к. пользовался меньше чем день.

Если кто-то вдруг не знает - теперь вы предупреждены.

Отличная работа, все прочитано!