Yardım sayfalardaki verileri çekip en büyüğünü yada küçük değeri söyleme

blackkugu · 20 Haz 2022

Merhaba arkadaşlar başlıkta anlaşılacağı üzerine sayfalardaki verinin en büyüğü yada en küçüğü hangi sayfada olduğunu öğrenmem gerek ama şöyle bir sorunum var.
8b1 8c2 8a1 6b1 6c1 5 tane sayfa ismi olsun sayfa ismi 8 ile başlayan ve bu sayfada a2 sutunundaki sayıları alıp ki 3 tane örnek sayfamız var a2 sutunundaki en büyük yada en küçük sayı hangi sayfada var verisini almak istiyorum
aramada 8 ile başlayan sayfaları taratıp
8b1 in A2 sutununda 10 olsun
8c2 in A2 sutununda 30 olsun
8a1 in A2 sutununda 70 olsun "8a1 sayfası diğer 8b1 ve 8c2 sayfasından daha büyüktür" şeklinde sonuç çıktısı almak istiyorum.

blackkugu · 20 Haz 2022

verileri arraya aktardım arkadaşlar tek sıkıntı array içerisindeki sayıların en büyük yada en küçük olanı nasıl bulabilirim. Örnek var mı elinizde ?

mesudiye_052 · 23 Haz 2022

Merhabalar

Kod:

Sub EnBuyukBul()
    Dim col As Collection
    Dim arr() As Variant
    Dim wsa As Worksheet
    Dim i As Long
    Dim enBuyuk As Double
 
    Set col = New Collection
 
    For Each wsa In ThisWorkbook.Worksheets
        If Not wsa Is ActiveSheet Then
            i = i + 1
            On Error Resume Next
            col.Add wsa, CStr(Application.WorksheetFunction.Max(wsa.Range("A2:A1000")))
            ReDim Preserve arr(1 To col.Count)
            arr(i) = Application.WorksheetFunction.Max(col(i).Range("A2:A1000"))
            On Error GoTo 0
        End If
    Next wsa
 
    enBuyuk = Application.WorksheetFunction.Max(arr)

    MsgBox "Enbüyük sayı: " & " " & enBuyuk & " " & col.Item(CStr(enBuyuk)).Name & "dedir"
    
    
    Set wsa = Nothing
    Set col = Nothing
    Erase arr
 
End Sub

mesudiye_052 · 25 Haz 2022

Merhabalar
Yeniden revize edilmiş hali

Kod:

Sub EnBuyukBul()
    Dim col As Collection
    Dim arr() As Variant
    Dim wsa As Worksheet
    Dim enBuyuk As Double
    
    Set col = New Collection
    
    For Each wsa In ThisWorkbook.Worksheets
        If Not wsa Is ActiveSheet Then
            On Error Resume Next
            col.Add wsa, CStr(Application.WorksheetFunction.Max(wsa.Range("A2:A1000")))
            ReDim Preserve arr(1 To col.Count)
            arr(col.Count) = Application.WorksheetFunction.Max(col(col.Count).Range("A2:A1000"))
            On Error GoTo 0
        End If
    Next wsa
    
    enBuyuk = Application.WorksheetFunction.Max(arr)

    MsgBox "Enbüyük sayı: " & " " & enBuyuk & " " & col.Item(CStr(enBuyuk)).Name & "de"
    
    Set wsa = Nothing
    Set col = Nothing
    Erase arr
End Sub

Yardım sayfalardaki verileri çekip en büyüğünü yada küçük değeri söyleme

blackkugu

blackkugu

mesudiye_052

mesudiye_052