excel做的BOM及其展算示例

allan

用Excel做的bom建立，订单输入，自动展算物料需求的示例，或许大家在工作中用得上

ufida_a

风吹草动  支持一下 可不能下

gbnew

请问2003 和 2007 有什么区别？

allan

一个是office 2003版一个是office 2007版

ufida_a

一个是office 2003版一个是2007版
一个是office 2003版一个是office 2007版

feslkp

不知道是复杂的还是简单的。不要名号太大了，不知道在WEB可以用吗

hayxb

谢谢
太贵,没有钱啊,俺这个穷人买不起啊

kevinyaocn

此例子为我原创，赚钱分点给我，发表于http://www.excelservice.cn/thread-577-1-1.html免费的
不过用在excel服务器中不太适合，适合单机，适合excel服务器版本在研究阶段，希望有兴趣的可以一起研究
奉献源代码
Public A, B, C, D, R1, R2, x, y, n 'E?订单总行数
Public T1, T2, T As Date

Sub yy()
V = MsgBox("**请确认订单表是否有空行!**", vbOKOnly, "温馨提示")
K = 1
R1 = 2
T1 = Now()
y = 2
D = Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
Sheet2.Range("g2:g65536").Clear
Sheet1.Range("a2:M65536").Clear
With Sheet1
On Error Resume Next
  .ShowAllData
End With
With Sheet2
On Error Resume Next
  .ShowAllData
End With
With Sheet3
On Error Resume Next
  .ShowAllData
End With
For z = 2 To D

'check bom.......................
B = Application.WorksheetFunction.CountIf(Sheet3.Range("A:A"), Sheet2.Cells(z, 1)) '
If B > 0 Then
Sheet2.Cells(z, 7) = "YES"
Else
Sheet2.Cells(z, 7) = "NO"
End If
'check bom............................
A = Sheet2.Cells(z, 1) '
With Sheet3.Range("a:a")
    Set C = .Find(A, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
        Sheet1.Cells(y, 1) = C
        x = C.Row
        Sheet1.Cells(y, 2) = Sheet3.Cells(x, 2)
        Sheet1.Cells(y, 3) = Sheet3.Cells(x, 3)
        Sheet1.Cells(y, 4) = Sheet3.Cells(x, 4)
        Sheet1.Cells(y, 5) = Sheet3.Cells(x, 5)
        Sheet1.Cells(y, 6) = Sheet3.Cells(x, 6)
        Sheet1.Cells(y, 7) = Sheet2.Cells(z, 2)
        Sheet1.Cells(y, 8) = Sheet2.Cells(z, 3)
        Sheet1.Cells(y, 9) = Sheet2.Cells(z, 4)
        Sheet1.Cells(y, 10) = Sheet2.Cells(z, 5)
        Sheet1.Cells(y, 11) = Sheet2.Cells(z, 6)
        Sheet1.Cells(y, 12) = Sheet1.Cells(y, 6) * Sheet1.Cells(y, 7)
         Sheet1.Cells(y, 13) = 1
        y = y + 1
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
Next z
R2 = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
Do
For n = R1 To R2
A = Sheet1.Cells(n, 3) '
With Sheet3.Range("a:a")
    Set H = .Find(A, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)
    If Not H Is Nothing Then
        firstAddress = H.Address
        Do
        Sheet1.Cells(y, 1) = Sheet1.Cells(n, 1)
        x = H.Row
        Sheet1.Cells(y, 2) = Sheet3.Cells(x, 2)
        Sheet1.Cells(y, 3) = Sheet3.Cells(x, 3)
        Sheet1.Cells(y, 4) = Sheet3.Cells(x, 4)
        Sheet1.Cells(y, 5) = Sheet3.Cells(x, 5)
        Sheet1.Cells(y, 6) = Sheet3.Cells(x, 6)
        Sheet1.Cells(y, 7) = Sheet1.Cells(n, 7)
        Sheet1.Cells(y, 8) = Sheet1.Cells(n, 8)
        Sheet1.Cells(y, 9) = Sheet1.Cells(n, 9)
        Sheet1.Cells(y, 10) = Sheet1.Cells(n, 10)
        Sheet1.Cells(y, 11) = Sheet1.Cells(n, 11)
        Sheet1.Cells(y, 12) = Sheet1.Cells(y, 6) * Sheet1.Cells(y, 7)
        Sheet1.Cells(y, 13) = K + 1
        y = y + 1
            Set H = .FindNext(H)
        Loop While Not H Is Nothing And H.Address <> firstAddress
    End If
End With
Next n
K = K + 1
R1 = R2 + 1
R2 = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
Loop Until R2 = (R1 - 1)
Sheet1.Activate
T2 = Now()
T = T2 - T1
Beep
U = MsgBox("***您展BOM所用的时间是: " & T, vbOKOnly, "kevinyao设计  2007/03/10")
End Sub

[ 本帖最后由 kevinyaocn 于 2008-4-19 20:43 编辑 ]

acheng517

原帖由 allan 于 2008-4-1 16:14 发表
一个是office 2003版一个是office 2007版

你回答的真经典。你挺有才。一般人想不到

cs160

这个在EXCELSERVICE中有下载,只要一个积分.楼主做人不厚 道