Загрузка данных


Sub SPLIT_LIC_CLAIM()
    
    
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim j As Long
    Dim newRow As Long
    Dim resultRows As Long
    Dim amount As Double
    'Ìàññèâ èñõîäíûõ äàííûõ è ðåçóëüòàòà
    Dim data As Variant
    Dim result As Variant

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set ws = ThisWorkbook.Worksheets("LIC CLAIM INPUT")

    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("LIC CLAIM").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
    newWs.Name = "LIC CLAIM"
    
    physicalPercent = Sheets("LIC CLAIM MAIN").Range("A2").Value
    legalPercent = Sheets("LIC CLAIM MAIN").Range("B2").Value

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    
    'Âñþ òàáëèöó â ïàìÿòü çàãðóæàåì
    data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value
    
    Set ugDict = CreateObject
    
    
    
    resultRows = 1

    For i = 2 To lastRow

        If IsNumeric(data(i, 4)) _
           And data(i, 4) <> "" Then

            resultRows = resultRows + 2

        Else

            resultRows = resultRows + 1

        End If

    Next i
    
    'Ñîçäàåì ìàññèâ äëÿ ðåçóëüòàòîâ
    ReDim result(1 To resultRows, 1 To lastCol)

    For j = 1 To lastCol
        result(1, j) = data(1, j)
    Next j

    newRow = 2

    For i = 2 To lastRow

        If IsNumeric(data(i, 4)) _
           And data(i, 4) <> "" Then

            amount = data(i, 4)

            For j = 1 To lastCol
                result(newRow, j) = data(i, j)
            Next j

            result(newRow, 1) = "ÎÑÀÃÎ_Ôèí"
            result(newRow, 4) = amount * physicalPercent

            newRow = newRow + 1

            For j = 1 To lastCol
                result(newRow, j) = data(i, j)
            Next j

            result(newRow, 1) = "ÎÑÀÃÎ_Þð"
            result(newRow, 4) = amount * legalPercent

            newRow = newRow + 1

        Else

            
            For j = 1 To lastCol
                result(newRow, j) = data(i, j)
            Next j

            newRow = newRow + 1

        End If

    Next i


    newWs.Range( _
        newWs.Cells(1, 1), _
        newWs.Cells(resultRows, lastCol) _
    ).Value = result
    

    newWs.Columns.AutoFit

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "ÃÎÒÎÂÎ!"

End Sub