نمایش نتایج: از شماره 1 تا 3 , از مجموع 3

موضوع: انتقال اطلاعات با شرط بوسیله vba

  1. #1


    آخرین بازدید
    2021/08/17
    تاریخ عضویت
    July 2010
    محل سکونت
    Yazd
    نوشته ها
    60
    امتیاز
    1
    سپاس
    15
    سپاس شده
    1 در 1 پست
    تعیین سطح نشده است

    انتقال اطلاعات با شرط بوسیله vba

    با سلام و عرض ادب
    در فایل پیوست , شیت 1 و در Table1 بعنوان دیتابیس ما هست حال می خواهیم با VBA اطلاعات دیتابیس ما با توجه به مقدار سلول H1 (ماه) و H2 (سال) در Table2 قرار بگیرد ضمنا اگر از قبل اطلاعات مربوط به ماه و سال انتخاب شده انتقال یافته بود پیغامی جهت یادآوری و درج مجدد یا عدم درج دوباره اطلاعات صادر گردد ممنون و متشکرم
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.
    فايل هاي پيوست شده فايل هاي پيوست شده

  2.  

  3. #2


    آخرین بازدید
    2021/08/17
    تاریخ عضویت
    July 2010
    محل سکونت
    Yazd
    نوشته ها
    60
    امتیاز
    1
    سپاس
    15
    سپاس شده
    1 در 1 پست
    تعیین سطح نشده است

    منتظر نظر دوستان هستیم

  4. #3


    آخرین بازدید
    2023/08/17
    تاریخ عضویت
    March 2015
    محل سکونت
    آمل
    نوشته ها
    3,342
    امتیاز
    11574
    سپاس
    1,884
    سپاس شده
    8,164 در 3,010 پست
    تعیین سطح نشده است

    با سلام

    با استفاده از دو دستور for ابتدا تک تک کدهای شیت اول را در شیت دوم چک کنید اگر وجود نداشت آن ردیف در شیت دوم ذخیره شود و اگر آن کد وجود داشت به شما پیغام بده


    کد PHP:
    Private Sub CommandButton1_Click()

    z1 Sheet1.Cells(Sheet1.Rows.Count"B").End(xlUp).Row

    z2 
    Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row 1
        
        
    If z2 3 Then z2 2


      
    For 3 To z1

    0

    For 2 To z2

    If Sheet1.Range("d" i) = Sheet2.Range("d" JThen

    1


    End 
    If

    Next

    If 0 Then

    Sheet1
    .Range("b" ":h" i).Copy Destination:=Sheet2.Range("b" z2)

    Sheet2.Range("a" z2) = 2

    z2 
    Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row 1

    Else

    ANSWER MsgBox("˜Ï:" " " Sheet1.Range("d" i) & vbNewLine " ÞÈáÇ ËÈÊ ÔÏå ÇÓÊ"vbYesNo vbQuestion)


    If 
    ANSWER vbYes Then


        
        Sheet1
    .Range("b" ":h" i).Copy Destination:=Sheet2.Range("b" J)


    z2 Sheet2.Range("Table2[[#Headers],[ãÇå]]").End(xlDown).Row 1
        
    Else

        
    'do nothing
        
    End If

    End If

    Next

    End Sub 
    فايل هاي پيوست شده فايل هاي پيوست شده
    ویرایش توسط iranweld : 2016/08/25 در ساعت 08:40

  5. سپاس ها (1)



اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. پرسش تبدیل فایل به pdf بوسیله ماکرو در اکسل
    توسط khalil2020 در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 2
    آخرين نوشته: 2021/01/06, 12:30
  2. پخش موسیقی در هنگام باز شدن فایل اکسل
    توسط sazar در انجمن فرم ها در ويژوال بيسيك - Forms in VBA
    پاسخ ها: 8
    آخرين نوشته: 2014/12/27, 16:38
  3. مشخص کردن سطری که انتخاب شده از سلول اول تا سلول انتخاب شده به وسیله یک کادر
    توسط sabertb در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 5
    آخرين نوشته: 2014/09/25, 10:27
  4. گزارشگیری از اکسل بوسیله نرم افزار های گزارشگیر
    توسط mokaram در انجمن پیوت تیبل و پايگاه داده - Pivot Table and Database
    پاسخ ها: 3
    آخرين نوشته: 2014/03/02, 20:11
  5. ارائه گزارش بوسیله پرینت
    توسط pishraw در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 8
    آخرين نوشته: 2014/01/05, 17:38

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

انجمن اكسل ايران , اكسل , اكسس , سوال و جواب اكسل , سوال اكسس , انجمن اكسل ايران , توابع اكسل, آموزش اكسل, آموزش اكسس, VBA, ويژوال بيسيك

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است
با ما در تماس باشيد