|
楼主 |
发表于 2022-3-14 11:34
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
一直出错哪里不对了啊 大神
Option Explicit
Option Base 1
Dim da, i&, j%, d As Object, d1 As Object, d2 As Object, d3 As Object
Dim m&, n&, S$, k, t, x%
Private Sub UserForm_Initialize()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Call MultiPage1_Change
End Sub
Private Sub 后道查询_Click()
Dim m3 As Long, m4 As Long '发出/交回
t = Split(d2.Item(后道款式.Text), "|")
ReDim temp(UBound(t) + 2, UBound(da, 2))
For j = 1 To UBound(da, 2)
temp(1, j) = da(2, j)
Next
For i = 0 To UBound(t)
x = t(i)
If da(x, 8) = "发出" Then
m3 = m3 + da(x, 5)
End If
If da(x, 8) = "交回" Then
m4 = m4 + da(x, 5)
End If
For j = 1 To UBound(da, 2)
temp(i + 2, j) = da(x, j)
Next
Next
ListBox5.List = temp
ListBox5.ColumnCount = UBound(da, 2)
TextBox44.Text = m3
TextBox45.Text = m4
TextBox46.Text = m3 - m4
End Sub
Private Sub 后道姓名_Change()
On Error GoTo Err1
d2.RemoveAll
For Each t In Split(d.Item(后道姓名.Text), "|")
S = Trim(da(t, 4)) '款式
If Not d2.Exists(S) Then
d2(S) = t
Else
d2(S) = d2(S) & "|" & t
End If
Next
后道款式.List = d2.Keys
后道款式.ListIndex = 0
Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub 套口姓名_Change()
On Error GoTo Err1
d1.RemoveAll
For Each t In Split(d.Item(套口姓名.Text), "|")
S = Trim(da(t, 4)) '款式
If Not d1.Exists(S) Then
d1(S) = t
Else
d1(S) = d1(S) & "|" & t
End If
Next
套口款式.List = d1.Keys
套口款式.ListIndex = 0
Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub MultiPage2_Change()
On Error GoTo Err1
n = 0: d.RemoveAll
Select Case MultiPage1.SelectedItem.Caption
Case Is = "后道查询"
With Sheets("缩絨统计")
i = .Range("B" & Rows.Count).End(3).Row
da = .Range("A1:I" & i).Value
End With
For i = 3 To UBound(da)
S = Trim(da(i, 3)) '姓名
If Not d.Exists(S) Then
d3(S) = i
Else
d3(S) = d3(S) & "|" & i
End If
Next
后道姓名.List = d.Keys
后道姓名.ListIndex = 0
Case Is = ""
End Select
Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub MultiPage1_Change()
On Error GoTo Err1
n = 0: d.RemoveAll
Select Case MultiPage1.SelectedItem.Caption
Case Is = "套口查询"
With Sheets("套口统计")
i = .Range("B" & Rows.Count).End(3).Row
da = .Range("A1:K" & i).Value
End With
For i = 3 To UBound(da)
S = Trim(da(i, 3)) '姓名
If Not d.Exists(S) Then
d(S) = i
Else
d(S) = d(S) & "|" & i
End If
Next
套口姓名.List = d3.Keys
套口姓名.ListIndex = 0
Case Is = ""
End Select
Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub 套口查询_Click()
Dim m1 As Long, m2 As Long '发出/交回
Dim f1 As Long, f2 As Long '返工
Dim yy As Long '样衣
t = Split(d1.Item(套口款式.Text), "|")
ReDim temp(UBound(t) + 2, UBound(da, 2))
For j = 1 To UBound(da, 2)
temp(1, j) = da(2, j)
Next
For i = 0 To UBound(t)
x = t(i)
If da(x, 10) = "发出" Then
m1 = m1 + da(x, 5)
f1 = f1 + da(x, 8) '返工
End If
If da(x, 10) = "交回" Then
m2 = m2 + da(x, 5)
f2 = f2 + da(x, 8) '返工
End If
yy = yy + da(x, 7)
For j = 1 To UBound(da, 2)
temp(i + 2, j) = da(x, j)
Next
Next
ListBox4.List = temp
ListBox4.ColumnCount = UBound(da, 2)
TextBox37.Text = m1: TextBox38.Text = f1
TextBox39.Text = m2: TextBox40.Text = f2
TextBox41.Text = m1 - m2
TextBox42.Text = f1 - f2
TextBox43.Text = yy
End Sub
|
|