|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Dim my()
Dim arrRow() As Long
Private Sub CommandButton5_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub CommandButton5_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub CommandButton5_Click()
Call SetListBox
End Sub
Private Sub CommandButton5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Private Sub CommandButton5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
End Sub
Private Sub Label1_Click()
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cs As Long
Dim X, Y, sh
Set sh = ActiveSheet
X = ActiveCell.Row
Y = ActiveCell.Column
cs = ListBox1.ListIndex
If cs <= 0 Then Exit Sub
Cells(X, "C") = CStr(ListBox1.List(ListBox1.ListIndex, 0))
Cells(X, "D") = CStr(ListBox1.List(ListBox1.ListIndex, 1))
Cells(X, "E") = CStr(ListBox1.List(ListBox1.ListIndex, 2))
Cells(X, "F") = CStr(ListBox1.List(ListBox1.ListIndex, 3))
Cells(X, "H") = ListBox1.List(ListBox1.ListIndex, 5)
Cells(X, "G") = CStr(ListBox1.List(ListBox1.ListIndex, 6))
ActiveCell.Offset(1, 0).Select
End Sub
Private Sub TextBox1_AfterUpdate()
Call SetListBox
End Sub
Private Sub UserForm_Initialize()
Call SetListBox
End Sub
Sub SetListBox()
Dim wIdx As Long
Dim endrow As Long
Dim temp()
Dim i As Long, j As Long
Erase my
Erase arrRow
ListBox1.Clear
w = ""
With ListBox1
.ColumnCount = 9 '设置列数
For j = 1 To 9
w = w & Sheet2.Cells(1, j).Width & ";"
Next
w = Left(w, Len(w) - 1)
.ColumnWidths = w
.ColumnHeads = False '是否显示列标题
A = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
If A < 3 Then A = 3
ReDim Preserve my(1 To 9, 1 To 1)
my(1, 1) = Sheet2.Range("A2") '
my(2, 1) = Sheet2.Range("B2") '
my(3, 1) = Sheet2.Range("C2") '
my(4, 1) = Sheet2.Range("D2") '
my(5, 1) = Sheet2.Range("E2") '
my(6, 1) = Sheet2.Range("F2") '
my(7, 1) = Sheet2.Range("G2") '
my(8, 1) = Sheet2.Range("H2") '
my(9, 1) = Sheet2.Range("I2") '
b = 1
For i = 3 To A
For j = 1 To 9
If Sheet2.Cells(i, j) Like "*" & TextBox1 & "*" Then
b = b + 1
ReDim Preserve my(1 To 9, 1 To b)
my(1, b) = Sheet2.Range("A" & i)
my(2, b) = Sheet2.Range("B" & i)
my(3, b) = Sheet2.Range("C" & i)
my(4, b) = Sheet2.Range("D" & i)
my(5, b) = Sheet2.Range("E" & i)
my(6, b) = Sheet2.Range("F" & i)
my(7, b) = Sheet2.Range("G" & i)
my(8, b) = Sheet2.Range("H" & i)
my(9, b) = Sheet2.Range("I" & i)
wIdx = wIdx + 1
ReDim Preserve arrRow(1 To wIdx)
arrRow(wIdx) = i
Exit For
End If
Next
Next
ReDim temp(1 To b, 1 To 9)
For i = 1 To b
For j = 1 To 9
temp(i, j) = my(j, i)
Next
Next
ListBox1.List() = temp
End With
End Sub
这是一段进销存系统的出库单录入的代码，请教老师，他是怎么定义我选中的数据填充到现有表单的哪个单元格的
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-9-25 14:17
楼主
