السلام عليكم و رحمة الله و بركاته
الترحيل الى شيت الاكسل عن طريق عمودين
انا عندي كود الترحيل الى شيت الاكسل بشرط اذا وجد قيمة Textbox1 في العمود A في شيت الاكسل لا يرحل و ان لم يجدها يرحل و هذا هو الكود الذي استعمله
if ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Find(TextBox1.Value) Is Nothing Then
و المطلوب منكم كود بحيث اذا وجد قيمة Textbox1 في العمود A و قيمة Textbox2 في العمود B في نفس السطر لا يرحل اما اذا وجد القيمتين مختلفتين و كذا اذا وجد قيمة TextBox1 و لم يجد قيمة TextBox2 يرحل
بارك الله فيكم و جزاكم الله خيرا
Posting to an Excel sheet by means of two columns
if ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Find(TextBox1.Value) Is Nothing Then
أفضل إجابة مقدمة من
salim
وهي:
وهل على من يريد المساعدة ان ينشأ ملفاً يحتوي على ما تريد ؟؟؟
الكود
Option Explicit
Private Sub But_Check_Click()
If Me.TextBox1 = "" Or Me.TextBox1 = "" Then Exit Sub
Dim Ro%, Sh As Worksheet, i%
Dim Bol As Boolean
Set Sh = Sheets("Sheet1")
Ro = Sh.Cells(Rows.Count, 1).End(3).Row
If Ro = 1 Then
Ro = 2
Sh.Cells(Ro, 1) = Me.TextBox1
Sh.Cells(Ro, 2) = Me.TextBox2
Exit Sub
End If
i = 2
Do Until i = Ro + 1
If UCase(Me.TextBox1) & "*" & UCase(Me.TextBox2) = _
UCase(Sh.Cells(i, 1)) & "*" & UCase(Sh.Cells(i, 2)) Then
Bol = True
MsgBox "This Values are Already Exsit" & Chr(10) & _
"In: " & Sh.Cells(i, 1).Resize(, 2).Address
Exit Sub
End If
i = i + 1
Loop
If Not Bol Then
Sh.Cells(Ro + 1, 1) = Me.TextBox1
Sh.Cells(Ro + 1, 2) = Me.TextBox2
End If
End Sub
الملف مرفق
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
