生产过程中，通常会遇到一些问题，解决问题中要做一些问题报告，一些企业会用到8D报告。
这个方法是国际公认的比较优秀的解决问题方法，下面对此做一个简单处理方法介绍。
软件平台：Windows Excel 2016
特点：表单式输入，界面简洁，输入方便
报告录入主页
信息输入大多在主页进行，一些信息在二级分页里，但不是很多。
具体内容看图，就不多介绍了。
下面引用D8问题解决法
D0：发现问题：针对要解决的问题，确认是否要用到8D问题解决法，并决定先决条件。
D1：成立小组：建立一个拥有产品或生产过程专业知识的人员小组。
D2：描述问题：用可以量化的何人、何物、何地、何时、为何、如何及多少钱来识别及定义问题。
D3：确认、实施并确认暂行对策：定义暂行对策矫正已知的问题，并实施并确认此对策。
D4：确认根本原因：找出所有可能会造成此问题的原因，并且找到为何在问题发生后没有注意到有问题。
D5：制定永久对策：经过试量产来确认永久对策已经解决客户端的问题。
D6：实施永久对策：定义并实施的对策。
D7：实施预防措施：为了避免此问题或类似问题再度发生，修改管理系统、操作系统、实务及流程。
D8：小组评价：认可团队整体的贡献，由组织正式感谢此团队。
8D问题解决表模版
模版做得比较简单，可能根据不同企业生产工艺情况，要进行一些修改，这个在于各自的使用情况决定。
发现问题
发现问题信息录入，单独做了一个输入表单，其引用了一个预设表内容。
其预设内容，可根据各自应用场景进行更改。
小组成员
小组成员，设置也很好理解，不做更多介绍。
代码
此次编程，代码做了很大改进，其重要点就是对表的处理有了更好的理解。
其赋值方面应用了更加简单和便捷的方法。
并且应用了更多的数组来做关键字处理，
Private Sub UserForm_Initialize()
Dim s As Worksheet, w As Worksheet
Set s = ThisWorkbook.Worksheets("sets")
Set w = ThisWorkbook.Worksheets("8D报告")
With Me
.Width = 800
.Height = 500
.Caption = s.Range("A2").Value & "8D报告--发现问题"
End With
Dim TObj As Object, TextObj As Object, Lobj As Object
Dim Tarr(), Ci, i As Integer, ix As Integer, ri As Integer
Tarr = Array("发现部门", "发生日期", "产品编号", "问题工序", "产品名称", "零件号")
Ci = Array("B", "", "", "C", "D", "")
Set Lobj = Me.Controls.Add("Forms.Label.1", "Titels")
With Lobj
.Top = 10
.Left = 0
.Width = Me.Width
.Height = 45
.TextAlign = 2
.Caption = Me.Caption
.ForeColor = RGB(205, 12, 1)
With .Font
.Size = 28
.Name = "微软雅黑"
.Bold = True
End With
End With
ix = UBound(Tarr)
For i = 0 To ix
Set TObj = Me.Controls.Add("Forms.Label.1", "Titels")
With TObj
.Top = 50 * i + 90
.Left = 200
.Width = 60
.Height = 28
.TextAlign = 1
.Caption = Tarr(i)
.ForeColor = RGB(205, 12, 1)
With .Font
.Size = 14
.Name = "微软雅黑"
.Bold = True
End With
End With
Set TextObj = Me.Controls.Add("Forms.ComboBox.1", "Text" & i)
With TextObj
.Top = 50 * i + 90
.Left = TObj.Width + TObj.Left + 20
.Width = 260
.Height = 30
.TextAlign = 1
w.Activate
Select Case i
Case 0
.ControlSource = w.Range("D2").Address
Case 1
.ControlSource = w.Range("D3").Address
Case 2
.ControlSource = w.Range("D4").Address
Case 3
.ControlSource = w.Range("F2").Address
Case 4
.ControlSource = w.Range("F3").Address
Case 5
.ControlSource = w.Range("F4").Address
End Select
s.Activate
If VBA.Len(Ci(i)) <> 0 Then
ri = s.Range(Ci(i) & "65535").End(xlUp).Row
.RowSource = s.Range(Ci(i) & "2:" & Ci(i) & ri).Address
.Value = Tarr(i)
End If
.ForeColor = RGB(1, 12, 1)
With .Font
.Size = 12
.Name = "微软雅黑"
End With
End With
Next i
End Sub
结尾
总之，接触8D报告比较少，所以过程当中可能存在不合理的地方，欢迎指出。
喜欢的朋友，关注、收藏