نمایش گزینه های متناظر هر عدد

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • arefi404

    • 2011/10/03
    • 20

    [حل شده] نمایش گزینه های متناظر هر عدد

    باسلام ودرود محضر اساتید محترم: متن سئوال در فایل پیوست موجود می باشد
    فایل های پیوست شده
  • amir_ts

    • 2015/03/17
    • 1247

    #2
    با سلام
    فایل نمونه را ملاحظه کنید.
    کد:
    [LEFT]
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Dim r As Range
       Dim vs As Variant  
    
       If Target.Count > 1 Then Exit Sub
     
       If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
          
    vs = Application.Match(Target.Cells.Offset(, -1), Sheets(2).Columns(1), 0)
    If IsError(vs) Then
    MsgBox "˜Ï ãæÑÏ äÙÑãæÌæÏ äãí ÈÇÔÏ"
    ElseIf Not IsError(vs) Then
    MsgBox Sheet2.Range("b" & vs)
    End If
    
     End Sub
    [/LEFT]
    فایل های پیوست شده
    [SIZE=7][B][COLOR=navy][FONT=IranNastaliq]ای برادر تو همه اندیشه ای[/FONT][/COLOR][/B][/SIZE]

    کامنت

    • arefi404

      • 2011/10/03
      • 20

      #3
      با سلام و تشکر کد ارائه شده تا حدودی مشکل حل شد اما این کد برای یک ستون می باشد درصورت امکان کدی که فقط برای مجموعه ای که نام گذاری شده ست( یعنی ممکن است اطلاعات شیت 2 غیر از ستون اول باشد) ارائه فرمایید .با تشکر و سپاس مجدد

      کامنت

      • amir_ts

        • 2015/03/17
        • 1247

        #4
        با سلام
        اگر شماره ستون شیت دو تغییر کرد شماره ستون را در قسمت قرمز رنگ کد قرار بدید.

        vs = Application.Match(Target.Cells.Offset(, -1), Sheets(2).Columns(1), 0)
        [SIZE=7][B][COLOR=navy][FONT=IranNastaliq]ای برادر تو همه اندیشه ای[/FONT][/COLOR][/B][/SIZE]

        کامنت

        • iranweld

          • 2015/03/29
          • 3341

          #5
          با سلام

          در فایل پیوست با انتخاب سلول ستون B یا با وارد کردن کد در یکی از سلول های ستون B کد متناظر آن از شیت دوم نمایش داده میشود

          کد PHP:
          Private Sub Worksheet_SelectionChange(ByVal Target As Range)

          Dim r As Range
             
             
          If Target.Count 1 Then Exit Sub

             
          If Len(Target) > And Not Intersect(TargetMe.Range("b:b")) Is Nothing Then
             
             Set r 
          Sheet2.Range("A2:S1000").Find(TargetLookAt:=xlWhole)
             
               If 
          r Is Nothing Then
               
               MsgBox 
          "˜Ï ãæÑÏ äÙÑãæÌæÏ äãí ÈÇÔÏ"
             
          Else
             
               
          MsgBox r.Offset(01) & " ˜Ï"
             
          End If
             
             
          End If

             
           
          End Sub 
          فایل های پیوست شده
          Last edited by iranweld; 2016/08/30, 12:55.

          کامنت

          • arefi404

            • 2011/10/03
            • 20

            #6
            باسلام مجدد ، فایل ذخیره نمیشه لطفاً مجدداً ارسال نمایید .

            کامنت

            • iranweld

              • 2015/03/29
              • 3341

              #7
              نوشته اصلی توسط arefi404
              باسلام مجدد ، فایل ذخیره نمیشه لطفاً مجدداً ارسال نمایید .
              برای ذخیره شدن مشکلی ندارد اینبار save as کنید ببنید مشکل شما رفع میشود

              کامنت

              چند لحظه..