请大神给写个VBA编程吧!
请大神帮忙给写个VBA.rar
(65.5 KB)
要求比较麻烦,请大神帮帮忙,急需!
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编辑过]