|
|
本帖最后由 mkm-_7605 于 2023-5-14 09:30 编辑
求大仙帮忙
我就是统计材料用的 ，我把表格改到我能改到的地步了
Public arr, X, i, Hx, k, d, arrSJ
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 And Me.ListBox1.ListIndex > 0 Then
k = Me.ListBox1.ListIndex
Call CR '键盘 Enter 键
ElseIf KeyCode > 48 And KeyCode < 58 Then
k = KeyCode - 48 '键盘1-9键
Call CR
ActiveCell.Offset(1).Select
ElseIf KeyCode = 37 Then
Me.TextBox1.Activate '键盘 左 键
ElseIf KeyCode = 27 Then
Call QC '键盘 Esc 键
End If
End Sub
Private Sub TextBox1_Change()
If TextBox1.Value <> "" Then
Hx = Sheet3.Range("b9999").End(xlUp).Row
arr = Sheet3.Range("A1:i" & Hx)
arr(1, 1) = "序号"
arr(1, 2) = "标号或组套产品代码"
arr(1, 3) = "部件产品代码"
arr(1, 4) = "27位"
arr(1, 5) = "注册证号"
arr(1, 6) = "单品名称"
arr(1, 7) = "规格"
arr(1, 8) = "型号"
arr(1, 9) = "企业"
'arr(1, 0) = "单价"
' arr(1, 11) = "单位"
ListBox1.ColumnWidths = "1;1;1;1;100;225;130;100;20,1" '设置下拉框里面显示的内容的宽度
X = 2 '从第二行显示数据库内容
For i = 1 To UBound(arr)
If InStr(arr(i, 1), UCase(TextBox1.Value)) > 0 Then '数据库第1列按拼音简写查找
arr(X, 1) = X - 1
'arr(X, 1) = arr(i, 1)
'arr(X, 1) = arr(i, 11)
' arr(X, 2) = arr(i, 10)
arr(X, 3) = arr(i, 2)
arr(X, 5) = arr(i, 4)
arr(X, 6) = arr(i, 5)
arr(X, 7) = arr(i, 7)
arr(X, 8) = arr(i, 8)
arr(X, 9) = arr(i, 9)
' arr(X, 11) = arr(i, 12)
X = X + 1
End If
Next
If X >= 2 Then
Sheet3.Range("Y1").Resize(X, 14) = arr
ReDim arr(X, 14) '下拉框显示的列数除简拼列外
arr = Sheet3.Range("y1:Am" & X - 1)
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 14 '显示下拉框里面的内容
Me.ListBox1.List = arr
Sheet3.Range("Y:Am").Clear
End If
Else
Me.ListBox1.Clear
End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then '键盘 Enter 键
If TextBox1.Value = "" Then
ActiveCell.Resize(1, 1).Borders.LineStyle = xlNone
ActiveCell.Resize(1, 2).Value = ""
Call QC
Else
k = 1
Call CR
ActiveCell.Offset(1).Select
End If
ElseIf KeyCode = 38 Then
ActiveCell.Offset(-1).Select '键盘 上 键
ElseIf KeyCode = 40 Then
ActiveCell.Offset(1).Select '键盘 下 键
ElseIf KeyCode = 27 Then
Call QC '键盘 ESC 键
End If
With Me.ListBox1
If KeyCode = 39 And .ListCount > 0 Then '键盘 右 键
If .ListCount > 1 Then .ListIndex = 1 Else .ListIndex = -1
.Activate
End If
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
With Target
If .Count = 1 And .Column = 3 And .Row > 4 And .Row < 112 Then '只有第4行-111行有提示功能，而且定位那列显示 column是那列是联想输入列
Set d = CreateObject("Scripting.Dictionary")
arrSJ = Sheet3.[a1].CurrentRegion
For i = 1 To UBound(arrSJ)
'd(arrSJ(i, 2)) = i
d(arrSJ(i, 2) & "|" & arrSJ(i, 3)) = i '条件2列3列和四列精准定位
Next
With Me.TextBox1
.Value = ""
.Top = Target.Top
.Left = Target.Left
.Width = Target.Width
.Height = Target.Height
.Activate
.Visible = True
End With
With Me.ListBox1
.ColumnHeads = False
.ColumnWidths = 25
.ListStyle = fmListStylePlain
.Top = Target.Top
.Left = Target.Left + Target.Width
.Width = 650
.Height = 200
.Visible = True
End With
Else
Call QC
End If
End With
End Sub
Sub CR()
On Error Resume Next
With ActiveCell
.Value = Me.ListBox1.List(k, 2)
bh = Me.ListBox1.List(k, 3) & "|" & Me.ListBox1.List(k, 4) & "|" & Me.ListBox1.List(k, 5) '条件2列3列和四列精准定位
.Offset(, 0).Value = Me.ListBox1.List(k, 2)
If d.exists(bh) Then
ActiveCell.Offset(0, 10) = arrSJ(d(bh), 10)
ActiveCell.Offset(0, 11) = arrSJ(d(bh), 11)
End If
.Offset(, -2).Value = Me.ListBox1.List(k, 12)
.Offset(, -1).Value = Me.ListBox1.List(k, 13) '设置显示那一列显示
.Offset(, 0).Value = Me.ListBox1.List(k, 1) '设置显示那一列显示
.Offset(, 1).Value = Me.ListBox1.List(k, 3) '设置显示那一列显示
.Offset(, 2).Value = Me.ListBox1.List(k, 5) '设置显示那一列显示
.Offset(, 3).Value = Me.ListBox1.List(k, 6) '设置显示那一列显示
.Offset(, 4).Value = Me.ListBox1.List(k, 7) '设置显示那一列显示
.Offset(, 5).Value = Me.ListBox1.List(k, 8) '设置显示那一列显示
' .Offset(, 10).Value = Me.ListBox1.List(k, 12) '设置显示那一列显示
' .Offset(, 11).Value = Me.ListBox1.List(k, 11) '设置显示那一列显示
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
Range("l3") = Format(Date, "yyyy年mm月dd日")
maxRow = 111
Range("o5:O" & maxRow) = "=IFERROR(L5*N5,"""")"
Range("M112") = "=SUM(O4:O112)"
End If
End Sub
Sub QC()
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
Me.TextBox1.Value = ""
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-5-13 17:05
楼主
