کپی کردن یک رنج خاص از اعداد

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • khorasan66

    • 2012/06/12
    • 111

    کپی کردن یک رنج خاص از اعداد

    با سلام خدمت تمامی اساتید :
    در ستون A رنج A4:A30 مقادیر مابین 1000 تا 1500 درج شده اند
    دستوری را نیاز دارم که تا 10 عدد از این رنج را که مساوی و یا بزرگتر از 1300 و مساوی و کوچک تر از 1500 میباشند را در صورت موجود بودن کپی نمودن و زیر هم مثلا از سلول A41:A50 جایگزین نماید .
    ضمناً اگر تعداد این مقادیر معین شده ( مساوی و یا بزرگتر از 1300 و مساوی و کوچک تر از 1500 ) در رنج A4:A30 از 10 تا بیشتر بود پیام داده و کار متوقف شود .
    با تشکر در صورت امکان با فایل نمونه پاسخ داده شود
  • امين اسماعيلي
    مدير تالار ويژوال بيسيك

    • 2013/01/17
    • 1198
    • 84.00

    #2
    RE: کپی کردن یک رنج خاص از اعداد

    با درود
    من کارتون رو انجام دادم به این نحو که ابتدا هر چی با این شرط که گفتین رو پیدا کنه و در شیت 2
    کپی کنه و اگر که بیش از 10 تا بود بقیشو پاک کنه . اینکه اگر بیش از 10 تا بود متوقف بشه و پیغامم بده با یه فرمول ساده و مسیج باکس راحته .


    حالا یه سوال دارم

    این اعداد رو میخواین بیشتریناشو داشته باشین یا فرق نداره و یا به قول خودتون اگر بیش از اون بود متوقف بشه.

    من خودم گفتم که بیش از 10 تا رو پاک کنه. ولی کاره شما که ساده تره.

    منتطر جواب میمونم. دوستان هم کمکی به این بنده حقیر بکنن جای دوری نمیره
    الان ساعت 1.5 شبه . که کاره دوستمون رو هم با حلقه for و هم auto filter به نحوی که اصلا معلوم نیست که autofilter انجام شد . گاهی به هم فکری شما هم نیاز دارم
    هر چند که این مسائل برای بسیاری از دوستان سادست

    قسط گلگی نبود . فقط همکاری بیشتر بود.
    در پناه خداوندگار ایران زمین باشید و پیروز

    کامنت

    • khorasan66

      • 2012/06/12
      • 111

      #3
      RE: کپی کردن یک رنج خاص از اعداد

      با سلام و تشکر
      اگر در این رنج یعنی a4:a30 تعداد اعداد خارج از شرط بیشتر از 10 تا باشد باید به کاربر هشدار بدهد تا تعداد این اعداد را به صورت دستی اصلاح نماید .
      ضمناً من هیچ دستور و یا فایل نمونه را دریافت نکردم .
      با تشکر
      من تا اینجا پیش رفتم بقیه اش کمک می خواهم
      Sub Copy_05()
      Dim d
      For Each d In Sheet5.Range("a4:a30")
      If d >= 1300 And d <= 1500 Then
      ؟؟؟؟؟؟؟؟
      ؟؟؟؟؟؟؟؟
      End If
      Next
      End Sub

      کامنت

      • khakzad

        • 2010/03/17
        • 2034
        • 85.00

        #4
        RE: کپی کردن یک رنج خاص از اعداد

        Dim d,i
        i=0
        For Each d In Sheet5.Range("a4:a30")
        If d >= 1300 And d <= 1500 Then i=i+1
        if i<10 go to 10
        next d
        else
        msgbox "adad kharej az shart hastand"
        exit sub
        end if
        [hr]
        سلام
        این کد خدمت شما
        امیدوارم ج بده
        فقط قبل از next d عدد 10 رو با یک space بعدش تایپ کنید.من نتونستم اینجا درست نشون بدم

        کامنت

        • امين اسماعيلي
          مدير تالار ويژوال بيسيك

          • 2013/01/17
          • 1198
          • 84.00

          #5
          RE: کپی کردن یک رنج خاص از اعداد

          با درود

          ممنون از خان خاک زاد
          دوست عزیز . من تو گفته هات به یه تناقض بر میخورم. اولش گفتی که اگر تو این رنج بیشتر از 10 تا بود و بعدش گفتی اگر اعداد که خارج از این رنج باشن......
          در پناه خداوندگار ایران زمین باشید و پیروز

          کامنت

          • امين اسماعيلي
            مدير تالار ويژوال بيسيك

            • 2013/01/17
            • 1198
            • 84.00

            #6
            RE: کپی کردن یک رنج خاص از اعداد

            با درود

            من روی او.ن موضوع که گفتین اگر بیش از 10 تا توی محدوده باشه پیام بده کار کردم.

            خوب به این صورت که در رنج A1 سر تیتر Number رو بنویسین و زیر اون هر چقدر که خواستین عدد بزارین. 2- در رنج C1 بنویسین result یا هرچی( نتیجه) یعنی میخوایم یه دکمه بزاریم و توی ستون A بگرده هذچی که بود و با شرایط ما جور در میومد رو بیاره تو ستون C از C2 به بعد بزاره و اون شرایطی رو هم که گفتین برسی کنه. خوب اگه کارای بالا رو انجام دادین یه CommandButton توی شیت 1 که داریم اونجا برسی میکنیم بزارین و روش دبل کلیک کنین تا به صفحه کد منتقل بشین و کد های زیر رو براش وترد کنین


            [undefined=undefined]


            Private Sub CommandButton1_Click()

            With Application
            ' Turn off screen updating to increase performance
            .ScreenUpdating = False
            End With
            Dim c
            Dim rngToCheck As Range
            Dim LastRow, lastrow2 As Long
            With Sheet1
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastrow2 = .Cells(.Rows.Count, "C").End(xlDown).Row
            End With
            Sheet1.Range("C2:C" & lastrow2) = ""

            Set rngToCheck = Sheet1.Range("A2:A" & LastRow)

            For Each c In rngToCheck
            If c.Value <> "" Then
            If c.Value >= 1300 And c.Value <= 1500 Then
            Sheet1.Range("C1").Offset(Application.WorksheetFun ction.CountA(Sheet1.Range("C1:C10000")), 0) = c.Value
            End If
            End If
            Next c
            If Sheet1.Range("C12").Value <> "" Then
            MsgBox " your Aria is more than 10 and all clear " & vbNewLine & "please Currect your range", vbCritical, "Error more 10"
            Sheet1.Range("C2:C" & lastrow2) = ""

            End If
            End Sub

            خوب حالا چک کنین.
            نمیدونم چرا وقتی کد حا رو کپی میکنیم تو تالار کجوکوله کپی میشن[hr]
            یه قولی به یه نفر دادم ولی چون مجبورم نمونه فایل رو بزارم چون کدها بدجوری کجو کوله اینجا کپی شدن

            لینک :

            http://uplod.ir/lfuyqtno1g05/Copy_specific_range.xlsm.htm


            از اینکه قولمونو مجبور شدیم بشکنیم از ...... معذرت میخوام .

            در پناه خداوندگار ایران زمین باشید و پیروز

            کامنت

            چند لحظه..