نمایش آدرس یک سلول در شیت دیگر

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • arad_o
    • 2019/09/29
    • 3

    [حل شده] نمایش آدرس یک سلول در شیت دیگر

    با سلام؛
    10 شیت مشابه با نامگذاری از 1 تا 10 که هر شیت دارای 15 سطر اطلاعات (به فرض در ستون e و در محدوده سطر 6 الی 20) که با اعداد مختلف تکمیل شده دارم و در یک شیت دیگر به مقدار ماکزیمم اطلاعات کل 10 شیت در محدوده مورد نظر ، نام یا کد شیتی که ماکزیمم در آن اتفاق افتاده و شماره ردیف (به فرض از ستون e ) که عدد ماکزیمم در آن اتفاق افتاده به صورت جداگانه (در 3 سلول مجزا) نیاز دارم.
    مقدار ماکزیمم را از فرمول زیر به دست آوردم:
    کد:
    [left]=max('1:10'!e6:e20)
    [/left]

    شماره شیت و ردیف مورد نظر رو چطور میتونم به دست بیارم؟

    (فایل نمونه پیوست شده (فایل اصلی خیلی گسترده تره))
    متشکرم.
    فایل های پیوست شده
  • M_ExceL

    • 2018/04/23
    • 677

    #2
    نوشته اصلی توسط arad_o
    با سلام؛
    10 شیت مشابه با نامگذاری از 1 تا 10 که هر شیت دارای 15 سطر اطلاعات (به فرض در ستون e و در محدوده سطر 6 الی 20) که با اعداد مختلف تکمیل شده دارم و در یک شیت دیگر به مقدار ماکزیمم اطلاعات کل 10 شیت در محدوده مورد نظر ، نام یا کد شیتی که ماکزیمم در آن اتفاق افتاده و شماره ردیف (به فرض از ستون e ) که عدد ماکزیمم در آن اتفاق افتاده به صورت جداگانه (در 3 سلول مجزا) نیاز دارم.
    مقدار ماکزیمم را از فرمول زیر به دست آوردم:
    کد:
    [LEFT]=max('1:10'!e6:e20)
    [/LEFT]

    شماره شیت و ردیف مورد نظر رو چطور میتونم به دست بیارم؟

    (فایل نمونه پیوست شده (فایل اصلی خیلی گسترده تره))
    متشکرم.
    سلام،
    کد زیر رو تست کنید :
    کد:
    Sub M_excel()
    
    Dim minvalue, maxvalue As Long
    Dim shtcounts, i As Long
    Dim cel, rng As Range
    Dim mxarr, mnarr As Variant
    
    shtcounts = Sheets.Count - 1
    ReDim mxarr(1 To shtcounts): ReDim mnarr(1 To shtcounts)
    
    For i = 1 To shtcounts
        shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
        Set rng = Sheets(i).Range("e6:e" & shtxlup)
        mxarr(i) = WorksheetFunction.Max(rng)
        mnarr(i) = WorksheetFunction.Min(rng)
    Next i
    minvalue = WorksheetFunction.Min(mnarr)
    maxvalue = WorksheetFunction.Max(mxarr)
    Sheets(11).Range("c3") = maxvalue: Sheets(11).Range("c8") = minvalue
    For i = 1 To shtcounts
        shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
        Set rng = Sheets(i).Range("e6:e" & shtxlup)
        mxarr(i) = WorksheetFunction.Max(rng)
        Set rng = Sheets(i).Range("e6:e" & shtxlup)
            For Each cel In rng
                If cel = maxvalue Then
                        Sheets(11).Range("c4") = cel.Offset(, -2)
                        Sheets(11).Range("c5") = Sheets(i).Cells(2, 12)
                    ElseIf cel = minvalue Then
                        Sheets(11).Range("c9") = cel.Offset(, -2)
                        Sheets(11).Range("c10") = Sheets(i).Cells(2, 12)
                End If
            Next
    Next i
    
    End Sub
    فایل های پیوست شده
    [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
    [/CENTER]

    کامنت

    • arad_o
      • 2019/09/29
      • 3

      #3
      نوشته اصلی توسط M_ExceL
      سلام،
      کد زیر رو تست کنید :
      خیلی ممنون از راهنمایی شما،
      کدی که شما نوشتید یه ایرادی داشت که کل ستون E رو برای محاسبه مینیمم و ماکزیمم در نظر میگرفت که من فقط به یک حدوده مشخص از سطر 6 الی 20 برای محاسبات نیاز داشتم که به صورت کد زیر یکم تغییرش دادم و ظاهرا جواب داد. این تغییراتی من ایجاد کردم جای دیگه مشکلی ایجاد نمیکنه؟؟؟
      کد:
      [LEFT]Sub T1_A()
      
      Dim minvalue, maxvalue As Long
      Dim shtcounts, i As Long
      Dim cel, rng As Range
      Dim mxarr, mnarr As Variant
      
      shtcounts = 10
      ReDim mxarr(1 To shtcounts): ReDim mnarr(1 To shtcounts)
      
      For i = 1 To shtcounts
          shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
          Set rng = Sheets(i).Range("e6:e20")
          mxarr(i) = WorksheetFunction.Max(rng)
          mnarr(i) = WorksheetFunction.Min(rng)
      Next i
      minvalue = WorksheetFunction.Min(mnarr)
      maxvalue = WorksheetFunction.Max(mxarr)
      Sheets(12).Range("c3") = maxvalue: Sheets(12).Range("c8") = minvalue
      For i = 1 To shtcounts
          shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
          Set rng = Sheets(i).Range("e6:e20")
          mxarr(i) = WorksheetFunction.Max(rng)
          Set rng = Sheets(i).Range("e6:e20")
              For Each cel In rng
                  If cel = maxvalue Then
                          Sheets(12).Range("c4") = cel.Offset(, -2)
                          Sheets(12).Range("c5") = Sheets(i).Cells(2, 12)
                      ElseIf cel = minvalue Then
                          Sheets(12).Range("c9") = cel.Offset(, -2)
                          Sheets(12).Range("c10") = Sheets(i).Cells(2, 12)
                  End If
              Next
      Next i
      
      End Sub[/LEFT]

      سوال دیگه این که اگر من بخوام این کد رو به ستونهای بیشتری از اطلاعات بسط بدم یعنی برای هر ستون این اطلاعات به صورت جداگانه استخراج بشه (فرضا علاوه بر ستون E برای ستونهای F و G و H و I و J هم مقدار مینیمم و ماکزیمم همراه به آدرس ردیف و کد شیت مشخص بشه) باید برای هر ستون یک ماژول جداگانه ایجاد کنم یا میتونم کد همه محاسبات را در یک ماژول بنویسم؟؟؟

      چون من خیلی به کد نویسی آشنایی ندارم بابت مبتدیانه بودن سوالاتم معذرت میخوام.

      کامنت

      • M_ExceL

        • 2018/04/23
        • 677

        #4
        نوشته اصلی توسط arad_o
        خیلی ممنون از راهنمایی شما،
        کدی که شما نوشتید یه ایرادی داشت که کل ستون E رو برای محاسبه مینیمم و ماکزیمم در نظر میگرفت که من فقط به یک حدوده مشخص از سطر 6 الی 20 برای محاسبات نیاز داشتم که به صورت کد زیر یکم تغییرش دادم و ظاهرا جواب داد. این تغییراتی من ایجاد کردم جای دیگه مشکلی ایجاد نمیکنه؟؟؟
        کد:
        [LEFT]Sub T1_A()
        
        Dim minvalue, maxvalue As Long
        Dim shtcounts, i As Long
        Dim cel, rng As Range
        Dim mxarr, mnarr As Variant
        
        shtcounts = 10
        ReDim mxarr(1 To shtcounts): ReDim mnarr(1 To shtcounts)
        
        For i = 1 To shtcounts
            shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
            Set rng = Sheets(i).Range("e6:e20")
            mxarr(i) = WorksheetFunction.Max(rng)
            mnarr(i) = WorksheetFunction.Min(rng)
        Next i
        minvalue = WorksheetFunction.Min(mnarr)
        maxvalue = WorksheetFunction.Max(mxarr)
        Sheets(12).Range("c3") = maxvalue: Sheets(12).Range("c8") = minvalue
        For i = 1 To shtcounts
            shtxlup = Sheets(i).Cells(Rows.Count, 5).End(3).Row
            Set rng = Sheets(i).Range("e6:e20")
            mxarr(i) = WorksheetFunction.Max(rng)
            Set rng = Sheets(i).Range("e6:e20")
                For Each cel In rng
                    If cel = maxvalue Then
                            Sheets(12).Range("c4") = cel.Offset(, -2)
                            Sheets(12).Range("c5") = Sheets(i).Cells(2, 12)
                        ElseIf cel = minvalue Then
                            Sheets(12).Range("c9") = cel.Offset(, -2)
                            Sheets(12).Range("c10") = Sheets(i).Cells(2, 12)
                    End If
                Next
        Next i
        
        End Sub[/LEFT]

        سوال دیگه این که اگر من بخوام این کد رو به ستونهای بیشتری از اطلاعات بسط بدم یعنی برای هر ستون این اطلاعات به صورت جداگانه استخراج بشه (فرضا علاوه بر ستون E برای ستونهای F و G و H و I و J هم مقدار مینیمم و ماکزیمم همراه به آدرس ردیف و کد شیت مشخص بشه) باید برای هر ستون یک ماژول جداگانه ایجاد کنم یا میتونم کد همه محاسبات را در یک ماژول بنویسم؟؟؟

        چون من خیلی به کد نویسی آشنایی ندارم بابت مبتدیانه بودن سوالاتم معذرت میخوام.
        سلام، خواهش میکنم
        در پاسخ سوال اولتون خیر مشکلی ایجاد نمیشه،
        در پاسخ سوال دوم، بله می تونید ماژول جدا هم ایجاد کنید
        اگر می خواهید یک کد همه ستون ها رو انجام دهد کد و فایل زیر رو تست کنید :
        کد:
        Sub M_excel()
        
        Dim minvalue, maxvalue As Long
        Dim shtcounts, i, ss As Long
        Dim cel, rng As Range
        Dim mxarr, mnarr As Variant
        Sheets(11).Range("h5:n" & Rows.Count).ClearContents
        shtcounts = Sheets.Count - 1
        ReDim mxarr(1 To shtcounts): ReDim mnarr(1 To shtcounts)
        For ss = 0 To 4
            For i = 1 To shtcounts
                Set rng = Sheets(i).Range("e6:e20").Offset(, ss)
                colname = Mid(Sheets(i).Range("e6:e20").Offset(, ss).EntireColumn.Address, 2, 1)
                mxarr(i) = WorksheetFunction.Max(rng)
                mnarr(i) = WorksheetFunction.Min(rng)
            Next i
            minvalue = WorksheetFunction.Min(mnarr)
            maxvalue = WorksheetFunction.Max(mxarr)
            Sheets(11).Range("i" & Rows.Count).End(3).Offset(1, 0) = maxvalue
            Sheets(11).Range("l" & Rows.Count).End(3).Offset(1, 0) = minvalue
            For i = 1 To shtcounts
                Set rng = Sheets(i).Range("e6:e20").Offset(, ss)
                    For Each cel In rng
                        If cel = maxvalue And cel <> "" Then
                                Sheets(11).Range("k" & Rows.Count).End(3).Offset(1, 0) = Sheets(i).Cells(cel.Row, 3)
                                Sheets(11).Range("j" & Rows.Count).End(3).Offset(1, 0) = Sheets(i).Cells(2, 12)
                            ElseIf cel = minvalue And cel <> "" Then
                                Sheets(11).Range("n" & Rows.Count).End(3).Offset(1, 0) = Sheets(i).Cells(cel.Row, 3)
                                Sheets(11).Range("m" & Rows.Count).End(3).Offset(1, 0) = Sheets(i).Cells(2, 12)
                        End If
                    Next
            Next i
             Sheets(11).Range("h" & Rows.Count).End(3).Offset(1, 0) = colname
        Next ss
        End Sub
        فایل های پیوست شده
        [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
        [/CENTER]

        کامنت

        • arad_o
          • 2019/09/29
          • 3

          #5
          نوشته اصلی توسط M_ExceL
          سلام، خواهش میکنم
          در پاسخ سوال اولتون خیر مشکلی ایجاد نمیشه،
          در پاسخ سوال دوم، بله می تونید ماژول جدا هم ایجاد کنید
          اگر می خواهید یک کد همه ستون ها رو انجام دهد کد و فایل زیر رو تست کنید :
          نتونستم روش دوم را به تمام متغیرهایی که دارم بسط بدم ولی با استفاده از روش اول و ایجاد ماژول اختصاصی برای هر متغیر بدون هیچ مشکلی نتیجه مورد نظرم رو به دست اوردم.
          خیلی ممنون از راهنمایی و وقتی که گذاشتید ....

          کامنت

          چند لحظه..