هدف جستجو،اصلاح و ارسال به شیت دیگر

**M_ExceL** · 2020/05/26, 15:50

نوشته اصلی توسط moshavereh

خدمت کلیه اعضا ومدیران سایت ضمن عرض تبریک عیدفطر

یک فایل دارم که هدف جستجو در بین اطلاعات بانکی > ویرایش اطلاعات و اضافه نمودن اطلاعات به نتایج جستجو > نهایتا کپی نتیجه به شیت دیگر

کدنویسی های زیادی دیدم توی سایت که اکثرا باگ داشتن و متاسفانه پس از حل مشکل فایل نهایی بارگذاری نشده بودند.

اومدم خود فایل رو بزارم خطا دادم rar کردم

ممنون از سایت خوبتون

با سلام،
برای رویداد چنج تکس باکس کد مشتری، کد زیر :

کد:

Private Sub TextBox1_Change()
Dim lstr, i, iCount As Long
Dim Item As Byte
Dim myarr As Variant
Dim rng As Range
lstr = Sheets(1).Cells(Rows.Count, 1).End(3).Row
Set rng = Sheets(1).Range("a2:j" & lstr)
myarr = rng

iCount = 0
For i = LBound(myarr) To UBound(myarr)
    If TextBox1.Text = myarr(i, 1) Then
        For Item = 0 To 9
            Me.ListBox1.AddItem
            Me.ListBox1.List(iCount, Item) = myarr(i, Item + 1)
        Next
    iCount = iCount + 1
    End If
Next


End Sub

برای رویداد چنج لیست باکس، کد زیر :

کد:

Private Sub ListBox1_Change()
Dim i As Long
Dim l As Byte
     For i = 0 To ListBox1.ListCount - 1
       If ListBox1.Selected(i) Then
            For l = 1 To 10
                form1.Controls("TextBox" & l) = Me.ListBox1.List(i, l - 1)
            Next
    
        
       End If
     Next
     form1.Show
End Sub

و برای ثبت مشخصات، کد زیر را وارد کنید :

کد:

Private Sub CommandButton1_Click()
Dim lstr As Long
lstr = Sheets(3).Cells(Rows.Count, 1).End(3).Row + 1
Dim l As Byte
For l = 1 To 10
    Sheets(3).Cells(lstr, l) = form1.Controls("TextBox" & l)
Next
Sheets(3).Cells(lstr, 11) = ComboBox1
Sheets(3).Cells(lstr, 12) = TextBox18
Sheets(3).Cells(lstr, 13) = TextBox19
Sheets(3).Cells(lstr, 14) = TextBox71
Sheets(3).Cells(lstr, 15) = TextBox81
MsgBox "اطلاعات با موفقيت ثبت گرديد"
    
End Sub

فایل نیز پیوست گردید بررسی بفرمایید.

فایل های پیوست شده