帮我妹写了一个，物料BOM的选料的Excel程序

如题，通过QQ联系。她们的Erp软件，还不是很完缮，所以，要把一个物料的BOM的清单，导出到excel表，然后人工选料. 效率低下，而且有时在短时间领导又催得紧.

下面是程序代码:

Private MaxRows As Long

Private Sub cmdClose_Click()
    Unload Me
End Sub

 

Private Sub cmdOK_Click()
    Dim iStart As Long
    Dim iEnd As Long
    Dim sh As Worksheet
    Set sh = ActiveSheet
    iStart = 2
    'iEnd = CLng(Me.txtEnd)
    Dim iRow As Long
    Dim iLevel As Long
    Dim pLevel As Long
    Dim sChild As String
    Dim i As Long, iAns As Long
    If CheckData(sh) = False Then
        iAns = MsgBox("数据表样式不对，是否继续? ", vbYesNo + vbQuestion + vbDefaultButton2, "提示")
        If iAns = vbNo Then
            Exit Sub
           
        End If
    End If
   
   ' Application.ScreenUpdating = False
    Application.StatusBar = "正在处理...."
   
   
    With sh
        MaxRows = getMaxRows(sh)  '求数据的最大行
       
       
       
        For i = iStart To MaxRows
            If i = 36 Then
                Stop
            End If

'            If InStr("KGP", .Range("J" & i)) <= 0 Then
'                MsgBox "'UIT'列，必须在 第J列,请通过插入或删除列，使其在 J 列在上"
'                Exit Sub
'            End If
'
           
           
            If sh.Range("C" & i) = "*R*" Then GoTo nNext
            If sh.Range("D" & i) = "**" Then GoTo nNext
           
            If InStr("KG", .Range("J" & i)) > 0 Then ' J->I
                If HasChild(i, sh, sChild) Then
                    setNextLevel不要 sChild, i, sh
                End If
            Else
                .Range("D" & i) = "**"
               
            End If
           
            If (i Mod 5) = 0 Then  '每5行更新一下状态
                Application.StatusBar = "正在处理...已完成 " & Int(i / MaxRows * 100) & "%"
            End If

nNext:
        Next i
    End With
   
        '处理*R*
    On Error Resume Next
   
    For i = 2 To MaxRows
        If sh.Range("C" & i) = "*R*" Then
       
            sh.Range("D" & i) = sh.Range("D" & i - 1)
        End If
       
    Next i
   
    MsgBox "成功完成,请核对一下!"
  
    Application.ScreenUpdating = True
    Application.StatusBar = "就绪"
   
    Unload Me
    
End Sub

 

Private Function setNextLevel不要(sParent As String, iParentRow, sh As Worksheet)
   '从某行这级的下级，不要
   '递归实现，这是本程序的关键
  
    Dim i As Long
    Dim sChild As String
    Dim bFind As Boolean  '找到了一个子节点
'    If sParent = "4405B00073C" Then Stop
   
    For i = iParentRow To MaxRows
        If sh.Range("C" & i) = "*R*" Then GoTo nNext
       
        If sh.Range("F" & i) = sParent Then
            sh.Range("D" & i) = "**"
            bFind = True
            If HasChild(i, sh, sChild) Then
                setNextLevel不要 sChild, i, sh  '递归
            End If
        Else
'            '如果这个节点，不是子节点，而上一行又是子节点
'            '就退出这个函数，不再看下面的节点了
'
'            If bFind = True Then Exit Function

        End If
       
   
   
nNext:
    Next i
   

End Function

 

Private Function HasChild(iRow As Long, sh As Worksheet, ByRef sChild As String) As Boolean
'判断某行，是否有子行
'并把子行的关键字-即关系字段求出来 给sChild

 

    With sh
        Dim s As String
        s = .Range("G" & iRow)
       
        If InStr(s, "- ") > 0 Then
            HasChild = True
            sChild = Mid(s, InStr(s, "-") + 2)
        Else
       
            HasChild = False
            sChild = ""
        End If
    End With
End Function

Private Function getMaxRows(sh As Worksheet) As Long
Dim i As Long
    For i = 2 To 60000
        If sh.Range("A" & i) = "" Then
            getMaxRows = i
            Exit For
        End If
    Next i
   
End Function

Private Function CheckData(sh As Worksheet) As Boolean
    CheckData = True
    With sh
        If .Range("C" & 1) <> "Child P/N Seq" Then
            MsgBox "Child P/N Seq 不在C列"
            CheckData = False
        End If
        If .Range("F" & 1) <> "Parent P/N" Then
            MsgBox "Parent P/N 不在F列"
            CheckData = False
        End If
       
        If .Range("G" & 1) <> "Child P/N" Then
            MsgBox "Child P/N 不在G列"
            CheckData = False
        End If
        If .Range("J" & 1) <> "UIT" Then
            MsgBox "UIT 不在 J 列"
            CheckData = False
        End If
    End With
           
End Function