用vba插入形态转换单数据和写入转换数量

用vba把形态转换单分组后,还有小部分无规则的需要人工手动分组,全部分组完成后,用数据透视表和U8系统结存做对比,无误后我们就可以写代码用vba插入形态转换单数据和写入转换数量.

Sub 形态转换插入数据()

    Dim i, irow, j, k As Integer
    Dim y As Single
    
    

    irow = Range("i65536").End(xlUp).Row

    For i = 5 To 3500
        k = Range("I" & i).Offset(0, 2)
        
        If Range("L" & i) = "" And k <> 2 And Range("I" & i) = Range("I" & i + 2) And Range("H" & i) > 0 And Range("H" & i + 1) < 0 Then
            Range("I" & i).Select
            Rows(i).Copy
            Range("L" & i) = -Range("H" & i + 1)
            Range("L" & i + 1) = -Range("H" & i + 1)
            
            For j = 1 To k - 2
                ActiveCell.EntireRow.Offset(2, 0).Select
                Selection.Insert Shift:=xlShiftDown
                Range("L" & ActiveCell.Row) = -Range("H" & ActiveCell.Row + 1)
                Range("L" & ActiveCell.Row + 1) = -Range("H" & ActiveCell.Row + 1)
                ActiveCell.EntireRow.Copy
            Next
        
        ElseIf Range("L" & i) = "" And k <> 2 And Range("I" & i) = Range("I" & i + 2) And Range("H" & i) > 0 And Range("H" & i + 1) > 0 Then
            
            y = Application.WorksheetFunction.Sum(Range("H" & i).Resize(k, 1))
            Range("M" & i) = y
            
            Rows(i + k - 1).Select
            Rows(i + k - 1).Copy
            Range("L" & ActiveCell.Row) = (Range("H" & ActiveCell.Row - 1) * 1000 - y * 1000) / 1000   '为了解决浮点误差问题乘1000/1000
            Range("L" & ActiveCell.Row - 1) = (Range("H" & ActiveCell.Row - 1) * 1000 - y * 1000) / 1000
            y = 0
            For j = k - 2 To 1 Step -1
                
                Rows(i + j).Select
                Selection.Insert Shift:=xlShiftDown
                Range("L" & ActiveCell.Row) = Range("H" & ActiveCell.Row - 1)
                Range("L" & ActiveCell.Row - 1) = Range("H" & ActiveCell.Row - 1)
                ActiveCell.EntireRow.Copy
            
            Next    
            ElseIf Range("L" & i) = "" And k = 2 And Range("I" & i) = Range("I" & i + 1) And Range("H" & i) > 0 And Range("H" & i + 1) < 0 Then
        
            Range("L" & i) = -Range("H" & i + 1)
            Range("L" & i + 1) = -Range("H" & i + 1)
        
        
        
        End If
    
    Next
    irow = Range("i65536").End(xlUp).Row
    MsgBox "OK"
    
End Sub