| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5392 人关注过本帖
标题:请大神给写个VBA编程吧!
只看楼主 加入收藏
cy5201314
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2021-6-26
收藏
 问题点数:0 回复次数:3 
请大神给写个VBA编程吧!
请大神帮忙给写个VBA.rar (65.5 KB)
要求比较麻烦,请大神帮帮忙,急需!
搜索更多相关主题的帖子: VBA 比较 编程 要求 
2021-07-05 08:30
zzj37995
Rank: 2
等 级:论坛游民
帖 子:6
专家分:27
注 册:2021-9-4
收藏
得分:0 
请将你的需求说清楚点
2021-09-04 22:25
厨师王德榜
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:199
帖 子:989
专家分:4966
注 册:2013-2-16
收藏
得分: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
Anfei1979
Rank: 3Rank: 3
来 自:湖北武汉
等 级:论坛游侠
威 望:4
帖 子:30
专家分:104
注 册:2021-12-11
收藏
得分:0 
EXCEL跨表引用,这并不麻烦。

南京工业大学理工科硕士,武汉某大型国有企业副科级干部
2021-12-11 16:54
快速回复:请大神给写个VBA编程吧!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.041165 second(s), 12 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved