Полезный скрипт для ведения журнала в Excel

Я веду свой журнал в Excel. Но есть одно неудобство. Сделки в QUIK представлены в виде списка транзакций, а не сделок как таковых с открытием и закрытием позиции. 

В журнале же нужно записывать сделку целиком с транзакцией на открытие и закрытие, чтобы видеть прибыль и убыток с каждой сделки.

Чтобы вручную не копировать строки в журнал, я написал две маленькие функции, которые выполняют одну простенькую задачу — они копируют сделку на закрытие и ставят ее рядом со сделкой на открытие. Конечно, перед этим нужно в Excel немного почистить данные, чтобы сделки были целиком (а не кусками по 1-2 лота) и по одному инструменту. 

Особенно это актуально при высокочастотном трейдинге, когда получается несколько сотен сделок в день.

Итак, вот что было:


Стало:





Код на VBA:

' Склеивает сделки
Sub mergeDeals()

    ' Объявление переменных
    Dim LastRow, prevRow As Long
    Dim i As Long, j As Long
    Dim myRange As String
   
    ' Выделяем Лист, с которым работаем
    Sheets("Лист1").Select

    ' Определяем число заполненных строк
    With Worksheets("Лист1")
        LastRow = .Cells(.rows.Count, "A").End(xlUp).Row
    End With

    ' Проходимся по всем строкам от 1 до последней
    For i = 1 To LastRow
        With Worksheets("Лист1")
            
            ' Если строка четная, то копируем ее и вставляем рядом с предыдущей строкой
            If i Mod 2 = 0 Then
                prevRow = i - 1
                myRange = "A" & i & ":" & "G" & i
                .Range(myRange).Copy Destination:=Worksheets("Лист1").Range("H" & prevRow)
                
                ' Удаляем содержимое скопированной строки
                .rows(i).ClearContents
            End If
        End With
    Next i
   
End Sub

' Удаляет пустые строки
Sub clearEmptyRows()

    ' Объявление переменных
    Dim r As Range, rows As Long, i As Long
    
    ' Объявление диапазона, в котором ищем пустые строки
    Set r = ActiveSheet.Range("A1:Z500")
    
    ' Удаление пустых строк
    rows = r.rows.Count
    For i = rows To 1 Step (-1)
        If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
    Next
End Sub