ارجو المساعده في الكود يوزر فورم
اريد تعديل الكود لي يتما الإرسال البيانات الى عمود G
وليس عمود H
وماهو اسطر المسؤول لتغير من عمود الى عمود اخر
Private Const ContColmn As Integer = 5
Private rng As Range
Private Colmn
Private Sub ButtonFind_Click()
End
End Sub
Private Sub ListFind_Click()
For i = 0 To ContColmn - 1
Me.Controls("Text" & i + 1).Value = Me.ListFind.Column(i)
Next
End Sub
Private Sub ListFind_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rng As Range, LR As Long
Dim x, y, z
'x = InputBox("Please enter a Quantity")
UserForm2.Show
x = UserForm2.TextBox1.Value
y = UserForm2.TextBox2.Value
z = UserForm2.TextBox3.Value
Unload UserForm2
If x = False Or StrPtr(x) = 0 Or Not IsNumeric(x) Then
Exit Sub
Else
LR = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row + 1
Set rng = Sheet1.Cells(LR, 4)
If ListFind.Value <> "" Then
rng.Value = ListFind.Value
rng.Offset(0, 1).Value = y
rng.Offset(0, 2).Value = x
rng.Offset(0, 3).Value = ListFind.List(ListFind.ListIndex, 2)
rng.Offset(0, 4).Value = z
End If
TextFind.SelStart = 0
TextFind.SelLength = Len(TextFind.Text)
TextFind.SetFocus
End If
End Sub
Private Sub TextFind_Change()
Dim MyValue
Dim MyAr() As String
Dim R As Integer, i As Integer, ii As Integer
Dim MyColmnFind As Integer, LastRow As Integer
MyColmnFind = Me.ComboFind.ListIndex + 1
If MyColmnFind = 0 Then Exit Sub
If MyColmnFind = 3 Then Me.TextFind = ""
Me.ListFind.Clear
With rng.Worksheet
LastRow = .Range("A65536").End(xlUp).Row
End With
Colmn = ""
With rng
For R = 2 To LastRow
If .Cells(R, MyColmnFind) Like "*" & TextFind & "*" Then
Colmn = Colmn & R & " "
ii = ii + 1
ReDim Preserve MyAr(1 To ContColmn, 1 To ii)
For i = 1 To ContColmn
MyValue = .Cells(R, i).Value2
MyAr(i, ii) = MyValue
Next
End If
Next
End With
If ii Then Me.ListFind.Column = MyAr: Me.ListFind.ListIndex = 0
End Sub
Private Sub UserForm_Activate()
Set rng = Sheet2.Range("A1").Resize(1, 2)
With Me.ComboFind
.Column = rng.Value
.ListIndex = 1
.Style = 2
End With
R = Range("D62").End(xlUp).Row
TextFind_Change
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set rng = Nothing
End Sub
اليوزر فورم.zip