-17

Помощь в VBA

Нужна помощь в написании комментариев к коду в VBA

Option Explicit ‘ Оператор, используемый чтобы обеспечить обязательное объявление всех используемых переменных

Public shp() As Shape, i As Long, j As Long, POLEWidth As Long, POLEHeight As Long, CellColor(1 To 5) As Long, numColor As Long ‘ оператор, используемый чтобы делать переменную доступной во всех процедурах всех модулей VBA в проекте

Private Const INF As Double = 1E+100 'значение бесконечности

Private Const maxEdge As Long = 8 'максимальное кол-во ребер для каждой вершины

Private Type Vertex 'тип для описания вершин

name As String 'наименование вершины

d As Double 'дистанция до текущей вершины

p As Long '"предок" до текущей вершины

u As Boolean 'метка о прохождении вершины, используется в алгоритме Дейкстры

edgeCount As Long 'количество ребер

nGraph(1 To maxEdge) As Long 'массив смежных вершин

dGraph(1 To maxEdge) As Double 'массив дистанций до смежных вершин

End Type

Public Sub Initialize ColorArray()

CellColor(1) = Навигатор.BackColor

CellColor(2) = vbGreen

CellColor(3) = vbRed

CellColor(4) = vbBlue

CellColor(5) = vbMagenta

SetColorLabel

End Sub

Public Sub SetPole()

POLEWidth = Val(Навигатор.txtPOLEWidth.Text): POLEHeight = Val(Навигатор.txtPOLEHeight.Text)

If POLEWidth < 10 Then POLEWidth = 10: Навигатор.txtPOLEWidth.Text = POLEWidth

If POLEHeight < 10 Then POLEHeight = 10: Навигатор.txtPOLEHeight.Text = POLEHeight

If POLEWidth > 100 Then POLEWidth = 100: Навигатор.txtPOLEWidth.Text = POLEWidth

If POLEHeight > 100 Then POLEHeight = 100: Навигатор.txtPOLEHeight.Text = POLEHeight

Dim ind As Long

ReDim shp(1 To POLEHeight, 1 To POLEWidth)

SetColorLabel

For i = 1 To POLEHeight

For j = 1 To POLEWidth

ind = ind + 1

On Local Error Resume Next

Load Навигатор.shpCell(ind)

Навигатор.shpCell(ind).Visible = True

Навигатор.shpCell(ind).Left = Навигатор.shpCell(ind).Width * (j - 1)

Навигатор.shpCell(ind).Top = Навигатор.shpCell(ind).Height * (i - 1)

Навигатор.shpCell(ind).FillColor = CellColor(1) ' CellColor(1)

Навигатор.shpCell(ind).FillStyle = 0

Set shp(i, j) = Навигатор.shpCell(ind)

Next j, i

Навигатор.frPOLE.Visible = True: Навигатор.frPOLE.Width = POLEWidth * Навигатор.shpCell(0).Width: Навигатор.frPOLE.Height = POLEHeight * Навигатор.shpCell(0).Height: 'Command2.Enabled = False

Навигатор.btnSTART.Enabled = True: Навигатор.btnSTOP.Enabled = True: Навигатор.btnFindPath.Enabled = True

End Sub

Public Sub SetColorLabel()

Навигатор.lblColor(2).BackColor = CellColor(2): Навигатор.lblColor(3).BackColor = CellColor(3): Навигатор.lblColor(4).BackColor = CellColor(4): Навигатор.lblColor(5).BackColor = CellColor(5):

End Sub

Public Sub SetCell(ByVal s As String)

Dim c As Long, k As Long, iter As Long, rn As Long, f As Boolean

Select Case s

Case "start": c = CellColor(2)

Case "stop": c = CellColor(3)

End Select

Do

iter = iter + 1

rn = Int(Rnd * POLEWidth * POLEHeight + 1)

If Навигатор.shpCell(rn).FillColor = CellColor(1) Then Навигатор.shpCell(rn).FillColor = c: f = True: Exit Do

Loop Until iter > 1000

Select Case s

Case "start": INFO "Старт" & IIf(f, " ", " не ") & "установлен ", IIf(f, vbBlue, vbRed)

Case "stop": INFO "Финиш" & IIf(f, " ", " не ") & "установлен ", IIf(f, vbBlue, vbRed)

End Select

End Sub

Public Sub ClearCell(ByVal s As String)

Select Case s

Case "start"

For i = 1 To POLEHeight

For j = 1 To POLEWidth

If shp(i, j).FillColor = CellColor(2) Then shp(i, j).FillColor = CellColor(1): Exit Sub

Next: Next

Case "stop"

For i = 1 To POLEHeight

For j = 1 To POLEWidth

If shp(i, j).FillColor = CellColor(3) Then shp(i, j).FillColor = CellColor(1): Exit Sub

Next: Next

Case "path"

For i = 1 To POLEHeight

For j = 1 To POLEWidth

If shp(i, j).FillColor = CellColor(5) Then shp(i, j).FillColor = CellColor(1)

Next: Next

Case "wall"

For i = 1 To POLEHeight

For j = 1 To POLEWidth

If shp(i, j).FillColor = CellColor(4) Then shp(i, j).FillColor = CellColor(1)

Next: Next

End Select

Call INFO

End Sub

Public Sub SetWall()

Навигатор.btnSTOP.Enabled = True: Навигатор.btnSTART.Enabled = True: Навигатор.btnFindPath.Enabled = True

If POLEHeight < 10 Then Exit Sub

ClearCell "path"

Dim k As Long, iter As Long, X As Long, rn As Long: k = Val(Навигатор.txtCountWalls.Text)

If (k <=

0 Or k > POLEHeight * POLEWidth - 2) And Навигатор.OpSet(4).Value = True Then INFO "Задано слишком большое число препятствий.", vbRed: Exit Sub

If Навигатор.OpSet(5).Value = True Then

MsgBox "Кликайте по полю для установки преград."

Else

ClearCell "wall"

Do

iter = iter + 1

rn = Int(Rnd * POLEWidth * POLEHeight + 1)

If Навигатор.shpCell(rn).FillColor = CellColor(1) Then

X = X + 1

Навигатор.shpCell(rn).FillColor = CellColor(4)

End If

Loop Until X >= k Or iter > 100000

INFO "Установлено препятствий: " & X

End If

End Sub

Public Function GetCountWalls() As Long

Dim k As Long

For i = 1 To POLEHeight

For j = 1 To POLEWidth

If shp(i, j).FillColor = CellColor(4) Then k = k + 1

Next: Next

GetCountWalls = k

End Function

Public Function GetNumber(ByVal X As Single, Y As Single, Optional ByRef i As Long = 1, Optional ByRef j As Long = 1) As String

i = Int(1 + (Y / Навигатор.shpCell(0).Height)): j = Int((X / Навигатор.shpCell(0).Width) + 1)

GetNumber = i & " | " & j

End Function

Public Sub INFO(Optional ByVal s As String = "", Optional ByVal c As Long = vbBlue)

Навигатор.lblINFO.Caption = s: Навигатор.lblINFO.ForeColor = c

End Sub

Public Sub SoftIceFind()

'Dim nP As Long, kP As Long, a() As Long

'a = GetArray(nP, kP)

'Call MyDijkstra(a, nP, kP)

INFO "Путь не найден"

End Sub

Дубликаты не найдены

+1

Ээээ... что именно сделать надо?

раскрыть ветку 16
0

Написать комментарий к каждой строке (что обозначает каждая строка)

раскрыть ветку 15
+3

Сколько предлагаешь за работу?

раскрыть ветку 14
0

- Это канал про аниме?

- Да.

- Как пропатчить KDE2 под FreeBSD?

0

Круто, а мне нужно много денег

Похожие посты
744

Автоматизация Excel с помощью VBA на примере графика отпусков

(Офисной оптимизации пост (теперь уже с примерами))


В прошлом своём посте (где рассматривал, что есть VBA в Excel и зачем это может пригодиться) целых 137 человек подписалось на меня, в комментариях были призывы к каким-нибудь примерам использования VBA, да и обещал я @Tiafreed подкинуть материалов для ВКР, так что набросал за ночь простенький (в сотню строк кода без использования массивов, классов и т.д.) файлик в Excel с VBA модулем. Пост разделю условно на две части: для пользователей, кому интересно просто посмотреть как выглядит, что делает, плюс скачать, поиграться и для продвинутых пользователей, кому интересно как это работает и как настроить подобное под себя. Цель поста - показать возможности VBA (частично), предложить интересный вариант реализации достаточно распространённой задачи по расчёту отсутствия сотрудников.

Если формат поста зайдёт, то в следующий раз набросаю пример, как формировать Word документы из списка данных в Excel, используя шаблон и пользовательскую форму (и не используя ублюдскую рассылку ИМХО).

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

Стартуем. Что нам нужно? Чтобы мы вносили людей в таблицу, забивали им отпуск, по нажатию одной кнопки машина рассчитывала нагрузку на каждый отдел (и организацию в целом) на каждый день и выделяла это графически. Бонус - построить график из полученных данных и научить выпадающий список самому подставлять данные в него прямо с листа двумя кликами.

Итак, какой порядок. Если запуск макросов разрешен, совместимость не барахлит, молния не ударила в системник после запуска файла и удача нам благоволит, то можем начинать. Сначала вносим данные (тут важное уточнение, даты я вношу в текстовом формате для удобства работы и совместимости).

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

*Все персонажи вымышлены, совпадения случайны


Дальше идём на другой лист, нажимаем кнопку

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

После чего идут расчёты какое-то время (у меня это где-то половина секунды)

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

Машина рапортует нам об успешном завершении своей миссии, идём смотреть, что вышло.

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

(Да, дизайнер я говно (как и VBA кодер в общем-то, но не об этом)) оформить самому никогда не сложно, главное, что на каждый день для каждого человека машина посчитала отпуска (можно любое другое отсутствие), вычислила цифры, разбила по отделам и отразила это графически, идём на главную

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

Тут всё ещё проще, кнопка для запуска, табличка с примитивными расчётами (формула МАКС) и график на 366 дней который можно с лёгкостью оформить самому и с помощью которого отлично видны провалы и пики нагрузок. Нажатием на выпадающий список, мы выбираем отдел по которому выводятся данные. Вот и всё, просто и удобно. Набросал за пару ночных часов. Сразу предупреждаю, что я это не предлагаю, как готовый продукт (успешное бизнес-решение ваших кадровых проблем), просто накидал маленький пример и делюсь им с вами, потому ответственность за его использование и обслуживание не несу, но если есть желание доработать его в своих целях, готов подсказать и помочь. Да, если возникла ошибка, вероятнее всего, что формат даты/числа нарушен, защиту от дурака не ставил, ибо цели чисто демонстрационные, но если вдруг мой косяк (протестить нет возможности) перезалью и ссылку в комментарии кину. Вот сам файл (на свой страх и риск :D, никаких гарантий, что будет работать). https://yadi.sk/d/lsRdKL8wQ42FFw (и не забываем включить макросы)

Сразу отвечу на вопрос - нахрена на VBA можно же на формулах? Да, можно, но так динамично (легко добавлять/убирать людей/отделы), наглядно и расчёт каждого дня формулами будет очень сильно грузить проц, а так мы считаем лишь раз, когда кнопку нажимаем.



Тэкс. Теперь вторая часть, в принципе, дальше можно не читать, так, для очистки совести её пишу. Кому интересно, как это работает или как вообще выглядит VBA на практике. Всё просто, в основе лежит вот эта строка (в ней мы будем искать колонку с датой отпуска и уже в ней работать)

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

Сначала мы подготавливаемся, что-то где-то очищаем, что-то добавляем (всё в общем-то закомментил) и сортируем строки по отделам

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

Потом запускаем цикл перебора строк с сотрудниками, в этом цикле для каждого работника мы проверяем, является ли он началом нового отдела, если да, то делаем разделитель, если нет - кладём болт и идём дальше, дальше рассчитываем отпуска, каким образом? Берём дату начала и ищем её в строке с датами, находим (или не находим и крашимся, если закосячили, не стал пилить защиту от дурака), берём эту ячейку как точку начала, прибавляем количество дней отпуска, отнимаем один (ибо включительно) и это наша точка окончания, объединяем эти ячейки, окрашиваем, в этих столбцах делаем простые расчёты (+1 к каждому дню и перерасчёт процентовки). После прохода по всем персонажам просто копируем полученные цифры на главную страницу, чтобы подставлять их в график. Всё, почти.

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост
Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

И простейший обработчик для выпадающего списка - просто вставляем в строку из которой берёт данные график данные из нужной нам строки. Рассчитываем её как номер строки начала (у нас 22) + номер элемента выпадающего списка (нумерация идёт с нуля у listindex)

Автоматизация Excel с помощью VBA на примере графика отпусков Excel, Программирование, Vba, Visual Basic, Офис, Оптимизация, Ms Office, Длиннопост

P.S. Знаю что говнокод, так что буду рад конструктивной критике, чему-то подучиться у более знающих. В свою защиту скажу, что код писался на халяву, без обработчика ошибок, заплаток, защиты от выстрелов в ноги, ограничений действий, фиксирования диапазона вводимых данных, добавления полосы загрузки и всё такое, чисто для демонстрации. Спасибо, если дочитал это до конца.

Показать полностью 10
Похожие посты закончились. Возможно, вас заинтересуют другие посты по тегам: