Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 23-06-2017, 12:34   #1
desıgner
Altın Üye
 
Giriş: 05/04/2017
Mesaj: 25
Excel Vers. ve Dili:
2007 tr
Varsayılan Verileri guruplama hususunda makro.

Merhabalar, ekli dosyada verilerin belirli kritere göre guruplandırılması ve
ilgili gurubun numaralandırılması ile ilgili bir makro ya ihtiyacım var.
Değerli bilgilerinizi paylaşırsanız sevinirim.
Eklenmiş Dosyalar
Dosya Türü: rar örnek.rar (7.1 KB, 15 Görüntülenme)
desıgner Çevrimdışı   Alıntı Yaparak Cevapla
Eski 23-06-2017, 14:13   #2
antonio
Destek Ekibi
 
antonio kullanıcısının avatarı
 
Giriş: 13/02/2011
Mesaj: 1,031
Excel Vers. ve Dili:
Excel 2013
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub gruplandir()
Dim sh As Worksheet, ss As Long, i As Long, puan As Integer, eski As Range, yeni As Range
puan = 0
Set sh = Sheets(1)
ss = sh.Range("E" & Rows.Count).End(3).Row
For i = 7 To ss
    Set eski = sh.Range("E" & i - 1)
    Set yeni = sh.Range("E" & i)
    If eski.Value <> yeni.Value Then
        puan = puan + 1
    End If
    sh.Range("H" & i).Value = puan
Next i
End Sub
__________________
Özel mesaj sistemini devre dışı bıraktım.
Yardım istemeden önce Forum Kurallarını okuyunuz.
Aynı konuyu farklı bölümlerde açanların sorularını yanıtlamıyorum, bu durumu fark etmeden yanıtlamışsam, mesajımı siliyorum.
antonio Çevrimdışı   Alıntı Yaparak Cevapla
Eski 23-06-2017, 14:21   #3
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,375
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Aşağıdaki formül boş satır açmaz, ancak gruplama yapar.
Formülü G7 yapıştırıp aşağı doğru çekin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
=EĞER(YADA(E6<>E7;F6<>F7);G6+1;G6)
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 23-06-2017, 17:47   #4
desıgner
Altın Üye
 
Giriş: 05/04/2017
Mesaj: 25
Excel Vers. ve Dili:
2007 tr
Varsayılan

İlginiz için teşekkür ederim,

Sayın antonio makro yanlış sonuç üretiyor.
Aynı zamanda boşlukların da açılması lazım.

Sayın asri, işlemin makro ile yapılması lazım.
desıgner Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-06-2017, 01:31   #5
desıgner
Altın Üye
 
Giriş: 05/04/2017
Mesaj: 25
Excel Vers. ve Dili:
2007 tr
Varsayılan

Merhabalar;
Tüm forum ahalisinin bayramı kutlu olsun.

Konu anlaşılmamış sanırım.
Döngü oluşturuyoruz.

E sütunu daki veri bir sonraki veri ile aynı ise,
ve bu verilerin karışlığında F sütunundaki verilerde birbirleri ile aynı ise
bu bir gurup olmuş oluyor. ve Bu guruba benzersiz bir numara veriyoruz.

Değerli yardımlarınızı bekliyorum. Örnek dosyada şekil olarak çıkması gereken sonucu
belirttim.
desıgner Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-06-2017, 02:28   #6
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,646
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Deneyiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit

Sub GRUPLANDIR()
    Dim Sayı As Long, Son As Long, X As Long, Y As Long
    Range("H7:H" & Rows.Count).ClearContents
    Range("E7:E" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Sayı = 1
    Son = Cells(Rows.Count, "E").End(3).Row
    For X = 7 To Son
        Cells(X, "H") = Sayı
        For Y = X + 1 To Son + 1
            If Cells(X, "E") & Cells(X, "F") = Cells(Y, "E") & Cells(Y, "F") Then
                Cells(Y, "H") = Sayı
            Else
                X = Y - 1
                Sayı = Sayı + 1
                Exit For
            End If
        Next
    Next
    
    For X = Son To 8 Step -1
        If Cells(X, "H") <> Cells(X - 1, "H") Then
            Rows(X).Insert
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 13:17


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden