• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tek Formülü Makroyla Sütunlara Uygulamak ?

Katılım
30 Mart 2011
Mesajlar
39
Excel Vers. ve Dili
2003
Türkçe
Sayın site yöneticisi ve forum sakinleri
Sizlere bir sorum olacaktır lütfen yardımcı olunuz. Sorum ;

Ekteki dosyada “Sayfa” isimli sayfada E2 ve S20000 arası hücrelere veriler girilecek(bu verilerin adı A,B,C vs..) ve bu girilen verilerin karşılarında B sütununda da puanlar olacaktır.(50,60,70 vs..)
Benim yapmak istediğim şey “sayfa” sayfasındaki bu verilerin min-max sayfasında ilgili verinin karşısına gelmesidir. Örneğin A verisinin min puanı 50 max puanı 75 gibi..
Bunu tek tek formülle yapabiliyorum ama çok yavaş işliyor o yüzden formülü makro şekilde min-max sayfasındaki “min” ve “max” sütunlarına uygulamak istiyorum.
Umarım anlatabilmişimdir yardımcı olan herkese şimdiden teşekkür ederim
 

Ekli dosyalar

Merhaba,

Eklediğiniz dosya ile açıklamalarınızın uyumlu olmasına dikkat ederseniz daha kısa ve net yanıtlar alırsınız.

Min-Max sayfasında veri adı yazmışsınız, fakat sayfa isimli sayfa bu verileri göremedim.

Eklediğiniz dosyayı bu doğrultuda gözden geçirip tekrar eklermisiniz.
 
ömer bey

örnek olsun diye rastgele birkaç veri girdim (A,B,C gibi)
tekrar ekledim umarım bu sefer doğru olmuştur.ilginiz için teşekkür ederim

özet : formülün yaptığı işi makronun yapmasını istiyorum böylece çok daha hızlı sonuç alabileyim yoksa formüllerin hesaplanması uzun sürüyor
 

Ekli dosyalar

Bu şekilde deneyin.

Kod:
Option Base 1
 
Sub Bul_Yaz()
 
    Dim Ss As Worksheet, c As Range, Adr As String, i As Long, Adet As Long, dizi() As Double
 
    Set Ss = Sheets("Sayfa")
 
    Application.ScreenUpdating = False
    Sheets("min-max ").Select
 
    Range("A2:B" & Rows.Count & ",D2:D" & Rows.Count).ClearContents
 
    With Ss.Range("E2:S" & Rows.Count)
        For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
            Adet = 0
            Set c = .Find(Cells(i, "C"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Adet = Adet + 1
                    ReDim Preserve dizi(Adet)
                    dizi(Adet) = Ss.Cells(c.Row, "B")
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
            If Adet <> 0 Then Cells(i, "A") = WorksheetFunction.Min(dizi)
            If Adet <> 0 Then Cells(i, "B") = WorksheetFunction.Max(dizi)
            Cells(i, "D") = Adet
        Next i
    End With
 
End Sub

.
 
teşekkür ederim ama sadece C2 hücresindeki veriyi gösteriyor(sadece örnek A verisi) diğerleri yok ben ise tüm C sütunundaki veriler için istiyorum
 
Son düzenleme:
Tüm C sütunundaki verilerin sonuçlarını A,B ve D sütununa yazmaktadır.
 
Tüm C sütunundaki verilerin sonuçlarını A,B ve D sütununa yazmaktadır.

formülü aşağı doğru çekersem oluyor fakat onu ben zaten yapabiliyorum ve yeni veri girişinde aşırı kasma oluyor benim istediğim tek bir makro ile A1 ve B1 hücrelerindeki formülün ilgili tüm sütuna uygulanması böylece aynı anda 100 veri de girsem kasma olmayacak

işte bunu nasıl yapıcam bir türlü bulamadım :(
 
Son düzenleme:
anlıyorum demek ki ben beceremedim yine de teşekkür ederim

Bu tür durumlarda yanlış sonuç aldığınız dosyayı eklerseniz nedeni konusunda daha net yorumlar yapmamıza yardımcı olmuş olursunuz.

Dosya ektedir.

.
 

Ekli dosyalar

Bu tür durumlarda yanlış sonuç aldığınız dosyayı eklerseniz nedeni konusunda daha net yorumlar yapmamıza yardımcı olmuş olursunuz.

Dosya ektedir.

.

teşekkür ediyorum

peki bu uygulamayı bul yaz şeklinde bir düğme ile değil de direkt veri girişi ile yapamaz mıyız ? yani o düğmeye basmadan her veri girildiğinde otomatik sistemin işlemesini sağlayabilir miyiz ? çünkü ben internet üzerinde bu işi yapıcam ve kişiler verilerini giricek bu verilerin sonuçları da kendiliğinden güncellenecek
 
ayrıca virgülden sonraki değerleri almıyor tam sayı olarak yazıyor örneğin 79,456 ise bunu 79,000 olarak yazıyor
 
ayrıca virgülden sonraki değerleri almıyor tam sayı olarak yazıyor örneğin 79,456 ise bunu 79,000 olarak yazıyor

Küsür sorunu diğer mesajlarda düzeltildi.

Veri girişi esnasında sonuç almak için;

min-max sayfasının kod bölümüne kopyalayın. C sütununa veri girişi esnasında kod çalışır.

Kod:
Option Base 1
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Ss As Worksheet, c As Range, Adr As String, Adet As Long, dizi() As Double
 
    If Intersect(Target, Range("C2:C" & Rows.Count)) Is Nothing Then Exit Sub
 
    Set Ss = Sheets("Sayfa")
 
    Application.ScreenUpdating = False
    Cells(Target.Row, "A").ClearContents
    Cells(Target.Row, "B").ClearContents
    Cells(Target.Row, "D").ClearContents
 
    If Target = "" Then Exit Sub
 
    With Ss.Range("E2:S" & Rows.Count)
        Adet = 0
        Set c = .Find(Target.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Adet = Adet + 1
                ReDim Preserve dizi(Adet)
                dizi(Adet) = Ss.Cells(c.Row, "B")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If Adet <> 0 Then Cells(Target.Row, "A") = WorksheetFunction.Min(dizi)
        If Adet <> 0 Then Cells(Target.Row, "B") = WorksheetFunction.Max(dizi)
        Cells(Target.Row, "D") = Adet
    End With
 
End Sub
 
küsürat sorunu hallolmuş teşekkürler fakat diğer konuda yanlış anlaşıldım
C'ye veri girişinde değil de "sayfa" sayfasına veri girişinde otomatik güncellensin istemiştim lütfen yardım edermsiiniz
 
sayfa adlı sayfanın hangi alanına veri girişi yapıldığında güncelleme olsun. Tam olarak hücre adresini belirtirmisiniz.
 
sayfa adlı sayfanın hangi alanına veri girişi yapıldığında güncelleme olsun. Tam olarak hücre adresini belirtirmisiniz.

E2 ve AH20000 hücreleri yeterli olur.(yani bu ikisi arasındaki tüm hücreler) "sayfa" sayfasında bu hücrelere veri girişi olunca min max sayfasında otomatik güncellensin istiyorum

özetle : sayfa sayfasında yukarıdaki hücrelere veri girilecek ve karşısındaki B sütununda bulunan sayılar min-max sayfasında A ve B sütunlarında otomatik güncellenecek.

umarım anlatabilmişimdir çok sağolun
 
A,B ve D sütunu sanırım.
 
sayfa adındaki sayfanın kod bölümüne kopyalayın. Eski kodları silersiniz.

Kod:
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sm As Worksheet, c As Range, Adr As String, Adet As Long, dizi() As Double, i As Long
    
    If Intersect(Target, Range("E2:AH" & Rows.Count)) Is Nothing Then Exit Sub
 
    Set Sm = Sheets("min-max ")
 
    Application.ScreenUpdating = False
    Sm.Range("A2:B" & Rows.Count & ",D2:D" & Rows.Count).ClearContents
    With Range("E2:AH" & Rows.Count)
        For i = 2 To Sm.Cells(Rows.Count, "C").End(xlUp).Row
            Adet = 0
            Set c = .Find(Sm.Cells(i, "C"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Adet = Adet + 1
                    ReDim Preserve dizi(Adet)
                    dizi(Adet) = Cells(c.Row, "B")
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
            
            If Adet <> 0 Then Sm.Cells(i, "A") = WorksheetFunction.Min(dizi)
            If Adet <> 0 Then Sm.Cells(i, "B") = WorksheetFunction.Max(dizi)
            Sm.Cells(i, "D") = Adet
                        
        Next i
    End With
 
End Sub

.
 
ömer bey herşey için sağolun sorunum çözüldü teşekkür ediyorum :)

fazla olmazsam son bir soru sormak istiyorum bu makrolu excel dosyasını google dokümanlarda nasıl çalıştırabilirim ? google dokümanlara aynı makro kodunu girebilir miyim ? denedim olmadı da eğer onun formatı farklıysa googke dokümanlara uygun formatta kodu tekrar yazabilir misiniz ?
 
sonradan farkettim D'deki adet miktarları değişiyor değişmemesi lazım :(
oradaki adet miktarlarına göre min-max belirlenecek ama öyle olmamış veri girildikçe artıyor :(
 
Adet miktarının min. max daki faktörü nedir? Sorularınızı detaylı açıklamanızı rica ederim.
 
Geri
Üst