Excel 2007 开发的分布式数据整合统计方案

  近日，工作上遇到了一些数据处理问题，同事一直头痛如何处理，我帮忙看了一下，情况是客户提供一堆测试方案文件，文件中的项目由不同部门完成，最后要把数据整合，并统计，总共有几百上千条。本来应该由IT 人员开发一个WEB 服务，按部门逐一分类，由各个部门负责人在网上更新 ，最后统计导出Excel .但这样做好像大费周章，写申请，等审核，一来一回没有半年三五个月都搞不定，还是自己动手丰衣足食。于是用Excel 2007 开发一个分布式数据整合统计方案 ，仅供参考。

 

流程图简介如下：

 

 

设计三个按钮，按下任务分按钮配如下图：

 

 

其中按钮时自动根据数据表里的部门集合，归类为一个按钮，其中一个按钮可以产生该部门相关的所有项目，该窗体有如下代码

 

Private Sub UserForm_Initialize()

Dim nCtr As MSForms.CommandButton
i = 2
j = 1
Sheets("HWV requirements").Range("Q5:Q400").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("HWV requirements").Range("AG1"), Unique:=True

    Do While Not Sheets("HWV requirements").Cells(i, 33) = ""
    
        Set nCtr = UserForm4.Controls.Add("Forms.CommandButton.1", "cmdTest" & i)
        With nCtr
            .Top = Me.Height / 6 * ((j - 1) \ 4) + 70
            .Left = Me.Width / 5 * ((j - 1) Mod 4) + 30
            .Width = 70
            .Height = 25
            .Caption = Cells(i, 33)
        End With
       
      
      Set ctlCB(i) = New cCB
                              ' 将控件赋给类实例
        ctlCB(i).Init nCtr
      
      i = i + 1
      j = j + 1
    Loop
 
  
  Sheets("HWV requirements").Columns(33).Delete
  Sheets("HWV requirements").Cells(1, 1).Select
  
End Sub

 

每一个按钮为一个控件类，用户可以根据这个调整窗体的属性外观按钮分布及大小，通过点击动作，可以实现把数据表里其中某一部门所有数据生成一个新的表，这样测试人员可以自己维护自己部门相关的测试项目，点击后会产生如下图表格：

 

控件类代码如下：

 

Private WithEvents m_CB As MSForms.CommandButton
' 初始化，将控件绑定到类
Public Sub Init(ctl As MSForms.CommandButton)
Set m_CB = ctl
End Sub
' 控件的Click事件
Private Sub m_CB_Click()

Dim stn As String
Dim i, j, k
   
    Dim a1()
    a1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28)
    j = 3
    i = 5
    k = 1
  
    stn = Trim(m_CB.Caption)
  
    stn = Replace(stn, "/", "-")
 
   
   
   If SheetExist(stn) = 0 Then
        'Sheets.Add.Name = stn
       
      Dim sh As Worksheet
      Set sh = Sheets.Add(after:=Worksheets("HWV requirements"))
      sh.Name = stn
  
      Dim btn1 As CommandButton
      Dim ole1 As OLEObject
      Set ole1 = sh.OLEObjects.Add(classtype:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=10, Top:=10, Width:=120, Height:=25)
      Set btn1 = ole1.Object
      btn1.Caption = "删除表  " & stn
 
      With ActiveWorkbook.VBProject.VBComponents(sh.CodeName).CodeModule
      .InsertLines 1, "Private Sub CommandButton1_Click()"
      .InsertLines 2, "Worksheets(" & Chr(34) & stn & Chr(34) & ").Delete"
      .InsertLines 3, "End Sub"
      End With
       
       
       
      Dim btn2 As CommandButton
      Dim ole2 As OLEObject
      Set ole2 = sh.OLEObjects.Add(classtype:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=10, Top:=20, Width:=120, Height:=25)
      Set btn2 = ole2.Object
      btn2.Caption = "更新表 " & stn
 
      With ActiveWorkbook.VBProject.VBComponents(sh.CodeName).CodeModule
      .InsertLines 1, "Private Sub CommandButton2_Click()"
      .InsertLines 2, "Dim i, j, k"
      .InsertLines 3, "Dim a1()"
      .InsertLines 4, "a1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,25,26,27,28)"
      .InsertLines 5, "j = 3"
      .InsertLines 6, "i = 5"
      .InsertLines 7, "k = 2"
  
  
      .InsertLines 8, " Key1 = MsgBox(""是否确定更新"", vbYesNo, ""提示"")"

      .InsertLines 9, "If Key1 = 6 Then"
  
      .InsertLines 10, "Application.ScreenUpdating = False"
      .InsertLines 11, "Do While Not Sheets(" & Chr(34) & stn & Chr(34) & ").Cells(j, 1) = """
        
      .InsertLines 12, " i = 5"
      .InsertLines 13, "Do While Not Sheets(""HWV requirements"").Cells(i, 1) = """
   
        ' If Trim(Sheets("HWV requirements").Cells(i, 17)) = "ODC HW" Then
    
      .InsertLines 14, "If Sheets(" & Chr(34) & stn & Chr(34) & ").Cells(j, 1) = Sheets(""HWV requirements"").Cells(i, 1) Then"
      .InsertLines 15, " For k = 2 To UBound(a1)+1"
      .InsertLines 16, " If Trim(Sheets(" & Chr(34) & stn & Chr(34) & ").Cells(j, k)) <> Trim(Sheets(""HWV requirements"").Cells(i, k)) Then"
        
      .InsertLines 17, "Sheets(" & Chr(34) & stn & Chr(34) & ").Cells(j, k).Copy"
      .InsertLines 18, "Sheets(""HWV requirements"").Cells(i, k).PasteSpecial"
      .InsertLines 19, "End If"
      .InsertLines 20, " Next"
      .InsertLines 21, "Exit Do"
      .InsertLines 22, " End If"
   
      .InsertLines 23, "i = i + 1"
      .InsertLines 24, "Loop"
      .InsertLines 25, "j = j + 1"
    
      .InsertLines 26, "Loop"
      .InsertLines 27, "Application.ScreenUpdating = True"
     
     .InsertLines 28, " End If"
     
      .InsertLines 29, "End Sub"

     End With
       
       
      Application.ScreenUpdating = False
        For k = 1 To UBound(a1) + 1
         Sheets("HWV requirements").Cells(3, k).Copy
         Sheets(stn).Cells(1, k).PasteSpecial
         Sheets(stn).Cells(1, k).Font.Size = "10"
         Sheets(stn).Cells(1, k).Font.Name = "Times New Roman"

        
         Sheets("HWV requirements").Cells(4, k).Copy
         Sheets(stn).Cells(2, k).PasteSpecial
         Sheets(stn).Cells(1, k).Font.Size = "10"
         Sheets(stn).Cells(1, k).Font.Name = "Times New Roman"
        
        Next
       
       Sheets(stn).Columns(5).ColumnWidth = 20
       Sheets(stn).Columns(6).ColumnWidth = 40
       Sheets(stn).Columns(25).ColumnWidth = 40
       Sheets(stn).Rows(1).RowHeight = 30
       Sheets(stn).Rows(2).RowHeight = 60
  
      
       Do While Not Sheets("HWV requirements").Cells(i, 1) = ""
   
        If Sheets("HWV requirements").Cells(i, 17) = Trim(m_CB.Caption) And Sheets("HWV requirements").Cells(i, 21) <> "" Then
          For k = 1 To UBound(a1) + 1
          Sheets("HWV requirements").Cells(i, k).Copy
          Sheets(stn).Cells(j, k).PasteSpecial
   
          '  Sheets("ODC HW").Rows(j).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          '  Application.CutCopyMode = False
          Next
    
          j = j + 1
         End If
        i = i + 1
       
        UserForm4.Label2.Width = Int(i / Sheets("HWV requirements").UsedRange.Rows.Count * 300)
        UserForm4.Label3.Caption = Int(i / Sheets("HWV requirements").UsedRange.Rows.Count * 100) & "%"
        DoEvents
       Loop
        Application.ScreenUpdating = True
        Sheets(stn).Cells(1, 1).Select
        MsgBox "进度完成!"
   Else
     key2 = MsgBox(stn & " already exist!", , "HWV Prompt")
   End If
   
   
   

End Sub
' 注销类
Private Sub Class_Terminate()
Set m_CB = Nothing
End Sub

Function SheetExist(strSheetName As String) As Integer
    Dim i                                 As Integer
    Dim nNumOfSheets           As Integer
    nNumOfSheets = Worksheets.Count
    For i = 1 To nNumOfSheets
            If Worksheets(i).Name = strSheetName Then Exit For
    Next
    SheetExist = i Mod (1 + nNumOfSheets)
End Function

 

其中次生成的表格中有插入两个按钮 其中更新表按钮是吧每个部门单独更新的结果回填到总表中，不用人工一条条对号。每个部门更新后，就可以统计结果，按下统计结果按钮，如下图就可以生成统计数据：

 

 

 

统计按钮代码如下：

Private Sub CommandButton2_Click()
hw_count = 0
hw_pass = 0
hw_fail = 0
hw_blocked = 0
hw_blank = 0

sit_count = 0
sit_pass = 0
sit_fail = 0
sit_blocked = 0
sit_blank = 0

siv_count = 0
siv_pass = 0
siv_fail = 0
siv_blocked = 0
siv_blank = 0

rel_count = 0
rel_pass = 0
rel_fail = 0
rel_blocked = 0
rel_blank = 0

other_count = 0
other_pass = 0
other_fail = 0
other_blocked = 0
other_blank = 0

For i = 5 To Sheets("HWV requirements").UsedRange.Rows.Count

If Sheets("HWV requirements").Cells(i, 17) = "ODC HW" And Sheets("HWV requirements").Cells(i, 21) <> "" Then
   hw_count = hw_count + 1
  If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
  hw_pass = hw_pass + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
  hw_fail = hw_fail + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
 hw_blocked = hw_blocked + 1
  Else
   hw_blank = hw_blank + 1
  End If

ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC SIT" And Sheets("HWV requirements").Cells(i, 21) <> "" Then
   sit_count = sit_count + 1
  If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
  sit_pass = sit_pass + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
  sit_fail = sit_fail + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
  sit_blocked = sit_blocked + 1
  Else
   sit_blank = sit_blank + 1
  End If

 

ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC SIV" And Sheets("HWV requirements").Cells(i, 21) <> "" Then
   siv_count = siv_count + 1
  If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
  siv_pass = siv_pass + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
  siv_fail = siv_fail + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
 siv_blocked = siv_blocked + 1
  Else
   siv_blank = siv_blank + 1
  End If

ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC REL" And Sheets("HWV requirements").Cells(i, 21) <> "" Then
   rel_count = rel_count + 1
  If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
  rel_pass = rel_pass + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
  rel_fail = rel_fail + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
  rel_blocked = rel_blocked + 1
  Else
   rel_blank = rel_blank + 1
  End If

 

ElseIf Sheets("HWV requirements").Cells(i, 21) <> "" Then

    other_count = other_count + 1
  If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
  other_pass = other_pass + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
  other_fail = other_fail + 1
  ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
  other_blocked = other_blocked + 1
  Else
   other_blank = other_blank + 1
  End If
  
 
 
End If

Next

'MsgBox (hw_count)
'MsgBox (sit_count)
'MsgBox (siv_count)

Sheets("Summary").Range("E27") = hw_pass
Sheets("Summary").Range("G27") = hw_fail
Sheets("Summary").Range("K27") = hw_blocked
Sheets("Summary").Range("M27") = hw_blank

Sheets("Summary").Range("E28") = 100 * hw_pass / hw_count & "%"
Sheets("Summary").Range("G28") = 100 * hw_fail / hw_count & "%"
Sheets("Summary").Range("K28") = 100 * hw_blocked / hw_count & "%"
Sheets("Summary").Range("M28") = 100 * hw_blank / hw_count & "%"

Sheets("Summary").Range("E29") = sit_pass
Sheets("Summary").Range("G29") = sit_fail
Sheets("Summary").Range("K29") = sit_blocked
Sheets("Summary").Range("M29") = sit_blank

Sheets("Summary").Range("E30") = 100 * sit_pass / sit_count & "%"
Sheets("Summary").Range("G30") = 100 * sit_fail / sit_count & "%"
Sheets("Summary").Range("K30") = 100 * sit_blocked / sit_count & "%"
Sheets("Summary").Range("M30") = 100 * sit_blank / sit_count & "%"

Sheets("Summary").Range("E31") = siv_pass
Sheets("Summary").Range("G31") = siv_fail
Sheets("Summary").Range("K31") = siv_blocked
Sheets("Summary").Range("M31") = siv_blank

Sheets("Summary").Range("E32") = 100 * siv_pass / siv_count & "%"
Sheets("Summary").Range("G32") = 100 * siv_fail / siv_count & "%"
Sheets("Summary").Range("K32") = 100 * siv_blocked / siv_count & "%"
Sheets("Summary").Range("M32") = 100 * siv_blank / siv_count & "%"

Sheets("Summary").Range("E33") = rel_pass
Sheets("Summary").Range("G33") = rel_fail
Sheets("Summary").Range("K33") = rel_blocked
Sheets("Summary").Range("M33") = rel_blank

Sheets("Summary").Range("E34") = 100 * rel_pass / rel_count & "%"
Sheets("Summary").Range("G34") = 100 * rel_fail / rel_count & "%"
Sheets("Summary").Range("K34") = 100 * rel_blocked / rel_count & "%"
Sheets("Summary").Range("M34") = 100 * rel_blank / rel_count & "%"

Sheets("Summary").Range("E35") = other_pass
Sheets("Summary").Range("G35") = other_fail
Sheets("Summary").Range("K35") = other_blocked
Sheets("Summary").Range("M35") = other_blank

Sheets("Summary").Range("E36") = 100 * other_pass / other_count & "%"
Sheets("Summary").Range("G36") = 100 * other_fail / other_count & "%"
Sheets("Summary").Range("K36") = 100 * other_blocked / other_count & "%"
Sheets("Summary").Range("M36") = 100 * other_blank / other_count & "%"

 

'统计表一

For j = 8 To 17

ww_plan = 0
ww_pass = 0
ww_fail = 0
ww_blocked = 0
ww_blank = 0

For i = 5 To Sheets("HWV requirements").UsedRange.Rows.Count
If Sheets("HWV requirements").Cells(i, 21) = Sheets("Summary").Cells(j, 1) Then
   If Sheets("HWV requirements").Cells(i, 22) = "pass" Then
    ww_pass = ww_pass + 1
   ElseIf Sheets("HWV requirements").Cells(i, 22) = "fail" Then
    ww_fail = ww_fail + 1
   ElseIf Sheets("HWV requirements").Cells(i, 22) = "blocked" Then
    ww_blocked = ww_blocked + 1
   Else
    ww_blank = ww_blank + 1
  End If
  ww_plan = ww_plan + 1
End If
Next
   Sheets("Summary").Cells(j, 2) = ww_plan
   Sheets("Summary").Cells(j, 3) = ww_pass
   Sheets("Summary").Cells(j, 4) = "=sum(C" & j & ",F" & j & ")"
   Sheets("Summary").Cells(j, 5) = ww_blocked
   Sheets("Summary").Cells(j, 6) = ww_fail
   Sheets("Summary").Cells(j, 7) = ww_blank

Next

'统计剩下

k = InputBox("Please input Work Week Example : ww51 ", "HWV Prompt")
Key1 = MsgBox(k, vbYesNo, "Is it correct?")

If Key1 = 6 Then

ww_hw_blank = 0
ww_sit_blank = 0
ww_siv_blank = 0
ww_rel_blank = 0
ww_other_blank = 0

For i = 5 To Sheets("HWV requirements").UsedRange.Rows.Count
If Sheets("HWV requirements").Cells(i, 21) = k Then
 If Sheets("HWV requirements").Cells(i, 17) = "ODC HW" Then
    If Sheets("HWV requirements").Cells(i, 22) = "" Then
     ww_hw_blank = ww_hw_blank + 1
    End If
 ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC SIT" Then
   If Sheets("HWV requirements").Cells(i, 22) = "" Then
     ww_sit_blank = ww_sit_blank + 1
   End If
 ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC SIV" Then
   If Sheets("HWV requirements").Cells(i, 22) = "" Then
    ww_siv_blank = ww_siv_blank + 1
   End If
 ElseIf Sheets("HWV requirements").Cells(i, 17) = "ODC REL" Then
   If Sheets("HWV requirements").Cells(i, 22) = "" Then
    ww_rel_blank = ww_rel_blank + 1
   End If
 Else
    If Sheets("HWV requirements").Cells(i, 22) = "" Then
     ww_other_blank = ww_other_blank + 1
    End If
 End If
End If
Next
     Sheets("Summary").Range("O27") = ww_hw_blank
     Sheets("Summary").Range("O29") = ww_sit_blank
     Sheets("Summary").Range("O31") = ww_siv_blank
     Sheets("Summary").Range("O33") = ww_rel_blank
     Sheets("Summary").Range("O35") = ww_other_blank

End If

 

 

tip = MsgBox("统计完成", , "提示")
End Sub

 

 

最后，按钮自动信任，是放在VBS运行错误，代码如下：

Private Sub CommandButton3_Click()
    Dim x
    On Error Resume Next
    Set x = ActiveWorkbook.VBProject
    If Err <> 0 Then
        Application.SendKeys "%TMST%V~"
    End If
End Sub