请大神给写个VBA编程吧！ - Excel/VBA论坛

cy5201314
等　级：新手上路
帖　子：4
专家分：0
注　册：2021-6-26
楼主
问题点数：0 回复次数：3
请大神给写个VBA编程吧！
请大神帮忙给写个VBA.rar (65.5 KB)
要求比较麻烦，请大神帮帮忙，急需！
搜索更多相关主题的帖子: VBA　比较　编程　要求　
2021-07-05 08:30
厨师王德榜
等　级：贵宾
威　望：199
帖　子：995
专家分：4966
注　册：2013-2-16
第 3 楼
得分:0
回复楼主 cy5201314
私信你了.
程序代码：
Public Type DingDan

 skbh As String

 ddbh As String

 khmc As String

 zzbh As String

 ddrq As Date

 jhrq As Date

 ccpgrq As Date

 jcpgrq As Date

 ctlx As String

 waij As Double

 neij As Double

 gaodu As Double

 sl As Double

 ccg As String

 mpsl As Double

 ccsl As Double

 neiD As Double

 waiD As Double

 ccLB As String


 jcg As String

 jcsl As Double

 jcLB As String


 DJCD As Double

 DJJD As Double

End Type

Sub Main()

Dim zb As Worksheet, sht1 As Worksheet, sht2 As Worksheet
Set zb = Worksheets("Sheet1")
zb.Activate
Dim ir As Long, irMax As Long
Dim irow1 As Long, irow2 As Long
irMax = zb.UsedRange.Rows.Count
irMax = 15
For ir = 4 To irMax
    Dim dd1 As DingDan
    
    With dd1
     .skbh = zb.Cells(ir, 1).Value
     .ddbh = zb.Cells(ir, 4).Value
     .khmc = zb.Cells(ir, 5).Value
     .zzbh = zb.Cells(ir, 6).Value
     .ddrq = zb.Cells(ir, 2).Value
     .jhrq = zb.Cells(ir, 3).Value
     .ccpgrq = zb.Cells(ir, 18).Value
     .jcpgrq = zb.Cells(ir, 30).Value
     .ctlx = zb.Cells(ir, 9).Value
     .waij = zb.Cells(ir, 10).Value
     .neij = zb.Cells(ir, 11).Value
     .gaodu = zb.Cells(ir, 12).Value
     .sl = zb.Cells(ir, 13).Value
     .ccg = zb.Cells(ir, 19).Value
     .mpsl = zb.Cells(ir, 20).Value
     .ccsl = zb.Cells(ir, 21).Value
     .neiD = zb.Cells(ir, 22).Value
     .waiD = zb.Cells(ir, 23).Value
     .ccLB = zb.Cells(ir, 24).Value
    
     .jcg = zb.Cells(ir, 31).Value
     .jcsl = zb.Cells(ir, 32).Value
     .jcLB = zb.Cells(ir, 33).Value
    
     .DJCD = zb.Cells(ir, 38).Value
     .DJJD = zb.Cells(ir, 39).Value
    End With
    
    If Len(Trim(dd1.ccg)) > 0 Then
        Set sht1 = Worksheets(dd1.ccg)
        sht1.Activate
        irow1 = ReturnLastRow(sht1, "粗车", IIf(dd1.ccLB = "计件", True, False))
        If dd1.ccLB = "计件" Then
            sht1.Cells(irow1, 1).Value = dd1.ccg
            sht1.Cells(irow1, 3).Value = dd1.ctlx
            sht1.Cells(irow1, 27).Value = IIf(dd1.ctlx = "偏心", 2.5, 1)
            sht1.Cells(irow1, 10).Formula = "=SUM(M" & irow1 & "*I" & irow1 & ")*AA" & irow1
            sht1.Cells(irow1, 4).Value = dd1.ddbh
            sht1.Cells(irow1, 5).Value = dd1.khmc
            sht1.Cells(irow1, 6).Value = dd1.waij
            sht1.Cells(irow1, 7).Value = dd1.neij
            sht1.Cells(irow1, 8).Value = dd1.gaodu
            sht1.Cells(irow1, 9).Value = dd1.ccsl
            sht1.Cells(irow1, 11).Value = dd1.neiD
            sht1.Cells(irow1, 12).Value = dd1.waiD
        Else
            sht1.Cells(irow1, 28).Value = dd1.ccg
            sht1.Cells(irow1, 30).Value = dd1.ctlx
            sht1.Cells(irow1, 54).Value = IIf(dd1.ctlx = "偏心", 2.5, 1)
            sht1.Cells(irow1, 37).Formula = "=SUM(an" & irow1 & "*aj" & irow1 & ")*bb" & irow1
            sht1.Cells(irow1, 31).Value = dd1.ddbh
            sht1.Cells(irow1, 32).Value = dd1.khmc
            sht1.Cells(irow1, 33).Value = dd1.waij
            sht1.Cells(irow1, 34).Value = dd1.neij
            sht1.Cells(irow1, 35).Value = dd1.gaodu
            sht1.Cells(irow1, 36).Value = dd1.ccsl
            sht1.Cells(irow1, 48).Value = dd1.neiD
            sht1.Cells(irow1, 49).Value = dd1.waiD
        End If
    End If
    
    If Len(Trim(dd1.jcg)) > 0 Then
        Set sht2 = Worksheets(dd1.jcg)
        sht2.Activate
        irow2 = ReturnLastRow(sht2, "精车", IIf(dd1.ccLB = "计件", True, False))
        If dd1.ccLB = "计件" Then
            sht2.Cells(irow2, 1).Value = dd1.jcg
            sht2.Cells(irow2, 3).Value = dd1.ctlx
            sht2.Cells(irow2, 39).Value = IIf(dd1.ctlx = "偏心", 2.5, 1)
            sht2.Cells(irow2, 10).Formula = "=SUM(M" & irow2 & "*I" & irow2 & ")*am" & irow2
            sht2.Cells(irow2, 4).Value = dd1.ddbh
            sht2.Cells(irow2, 5).Value = dd1.khmc
            sht2.Cells(irow2, 6).Value = dd1.waij
            sht2.Cells(irow2, 7).Value = dd1.neij

            sht2.Cells(irow2, 9).Value = dd1.jcsl

        Else
            sht2.Cells(irow2, 40).Value = dd1.jcg
            sht2.Cells(irow2, 42).Value = dd1.ctlx
            sht2.Cells(irow2, 78).Value = IIf(dd1.ctlx = "偏心", 2.5, 1)
            sht2.Cells(irow2, 49).Formula = "=SUM(az" & irow2 & "*av" & irow2 & ")*bz" & irow2
            sht2.Cells(irow2, 43).Value = dd1.ddbh
            sht2.Cells(irow2, 44).Value = dd1.khmc
            sht2.Cells(irow2, 45).Value = dd1.waij
            sht2.Cells(irow2, 46).Value = dd1.neij
            
            sht2.Cells(irow2, 48).Value = dd1.jcsl
            
        End If
        
        If dd1.DJCD + dd1.DJJD <> 0 Then
        ' 要求2：总表中，精车倒角，长度（AL），角度（AM）列的数据自动录入精车工（范永召、王岩新）二人分表的倒角列中；
        ' 这个要求明显没有把需求说清楚，是录入到范还是王的表中？ 还是范、王的表中都录入一次？还是随便选范、王中的一个录入？
        ' 还是说，只有范、王二位师傅才会派转角的工单，其它人不会出现派工？
            sht2.Cells(irow2, 79).Value = dd1.jcg
            sht2.Cells(irow2, 84).Value = dd1.DJCD
            sht2.Cells(irow2, 86).Value = dd1.DJCD
            sht2.Cells(irow2, 85).Value = dd1.jcsl
            sht2.Cells(irow2, 87).Value = dd1.DJJD
            sht2.Cells(irow2, 80).Value = dd1.ddbh
            sht2.Cells(irow2, 81).Value = dd1.khmc
            sht2.Cells(irow2, 82).Value = dd1.waij
            sht2.Cells(irow2, 83).Value = dd1.neij
        End If
        
    End If
    
Next ir
End Sub

Function ReturnLastRow(ByVal sht As Worksheet, _
    ByVal cglx As String, _
    Optional ByVal jjgz As Boolean) As Long
    Dim ir As Long, iretu As Long
    
    sht.Activate
    If cglx = "精车" Then
        If jjgz = True Then
            For ir = 4 To sht.UsedRange.Rows.Count
                If Cells(ir, 9) = 0 Then
                    iretu = ir
                    Exit For
                End If
            Next ir
        Else
            For ir = 4 To sht.UsedRange.Rows.Count
                If Cells(ir, 48) = 0 Then
                    iretu = ir
                    Exit For
                End If
            Next ir
        End If
    Else
        If jjgz = True Then
            For ir = 4 To sht.UsedRange.Rows.Count
                If Cells(ir, 9) = 0 Then
                    iretu = ir
                    Exit For
                End If
            Next ir
        Else
            For ir = 4 To sht.UsedRange.Rows.Count
                If Cells(ir, 36) = 0 Then
                    iretu = ir
                    Exit For
                End If
            Next ir
        End If
    End If
    ReturnLastRow = IIf(iretu = 0, 4 + 1, iretu)
End Function
[此贴子已经被作者于2021-9-13 15:41编辑过]
2021-09-13 15:38