[Çözüldü]  Aynı Metin/Rakamları Saydırma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Aynı Metin/Rakamları Saydırma

İleti#1)  M-a-d » 12 Mar 2019 11:01

Merhaba,

Excel'den 65000 satırdan oluşan bir raporum mevcut aynı seri numaralarının kaç defa yazıldığını makro ile bulabilir miyim?

Eğersay işlemi ile yapıyorum fakat liste çok uzun olduğu için kasma yapıyor bu konu hakkında nasıl çözüm sunabilirsiniz?
Kullanıcı avatarı
M-a-d
 
Kayıt: 17 Oca 2019 16:23
Meslek: Satış Sonrası
Yaş: 31
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Ümraniye

Cevap: Aynı Metin/Rakamları Saydırma

İleti#2)  Vedat ÖZER » 12 Mar 2019 12:05

Merhaba,

Örnek dosya ekleyebilir misiniz.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya

Cevap: Cevap: Aynı Metin/Rakamları Saydırma

İleti#3)  M-a-d » 12 Mar 2019 12:17

Vedat ÖZER yazdı:Merhaba,

Örnek dosya ekleyebilir misiniz.


Merhaba,

Örnek dosya ekteki gibidir.
Kullanıcı avatarı
M-a-d
 
Kayıt: 17 Oca 2019 16:23
Meslek: Satış Sonrası
Yaş: 31
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Ümraniye

Cevap: Aynı Metin/Rakamları Saydırma

İleti#4)  Vedat ÖZER » 12 Mar 2019 13:19

Merhaba,

Aşağıdaki kodu deneyebilir misiniz.

Kod: Tümünü seç
Sub SAY()
   
    Dim son_satir&
    Zaman = Timer
    With Application
    .ScreenUpdating = False
    End With

    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    Range("E2:L" & Rows.Count).ClearContents
    son_satir = Cells(Rows.Count, "C").End(3).Row
   

    Set rs1 = VBA.CreateObject("adodb.Recordset")
    SORGUU = "SELECT [SD].SAY  from [Sayfa1$] AS [SK]  LEFT OUTER JOIN(SELECT F3 AS [G],COUNT(F3) AS [SAY]  from [Sayfa1$]  GROUP BY F3 ) AS [SD] ON [SD].G=[SK].F3  "
    rs1.Open SORGUU, con
    Range("E1").CopyFromRecordset rs1
    Range("e1") = "Sayı"
   
    With Application
    .ScreenUpdating = True
    End With
    MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Aynı Metin/Rakamları Saydırma

İleti#5)  AhmetRasim » 12 Mar 2019 13:25

Merhabalar;
Örnek olarak şu kodları dener misiniz?
Kod içindeki şu bölümleri çalışmanıza göre değiştiriniz;
Sayfa1 = Verilerin bulunduğu sayfanın Sekme İsmi
Sayfa2 = Sayma sonuçlarının yazılacağı sayfanın Sekme İsmi
Columns("A:A") = Seri Numaralarının bulunduğu Sütun
Range("A2:A" & s1.Range("A65536") = Seri Numaralarının bulunduğu Sütun Harfleri ile değiştiriniz.

Kodun çalışma şekli şu şekilde;
-Sayfa1 A sütununu Sayfa2 ye kopyalar
-Sayfa2 de A sütununda Yinelenen Değerleri kaldırır
-Sayfa2 A sütunundaki değerleri Sayfa1 de EğerSay formülü ile sayar.
Kod: Tümünü seç
Sub say()

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A:B").Clear
    s1.Columns("A:A").Copy s2.Range("A1")
   
    s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
   
   For x = 2 To Range("A65536").End(3).Row
   Cells(x, "B") = Application.WorksheetFunction.CountIf(s1.Range("A2:A" & s1.Range("A65536").End(3).Row), Cells(x, "A"))
   Next x
   
End Sub
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 21:40
Konum: İstanbul
Meslek: Serbest
Yaş: 33
İleti: 1097
 
Cinsiyet: Bay

Cevap: Aynı Metin/Rakamları Saydırma

İleti#6)  AhmetRasim » 12 Mar 2019 13:30

Merhabalar;
Düzenleme yaparken Sn. Vedat ÖZER'in paylaşımını görmedim.
ADO ile daha kısa sürede tamamlanır işlem. şkşk --)(
Kullanıcı avatarı
AhmetRasim
Site Dostu
 
Adı Soyadı:Ahmet Rasim
Kayıt: 20 Kas 2013 21:40
Konum: İstanbul
Meslek: Serbest
Yaş: 33
İleti: 1097
 
Cinsiyet: Bay

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Aynı Metin/Rakamları Saydırma

İleti#7)  Vedat ÖZER » 12 Mar 2019 13:50

Ahmet bey paylaşımınız için teşekkür ederim.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya

Cevap: Cevap: Aynı Metin/Rakamları Saydırma

İleti#8)  M-a-d » 12 Mar 2019 14:13

Vedat ÖZER yazdı:Merhaba,

Aşağıdaki kodu deneyebilir misiniz.

Kod: Tümünü seç
Sub SAY()
   
    Dim son_satir&
    Zaman = Timer
    With Application
    .ScreenUpdating = False
    End With

    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    Range("E2:L" & Rows.Count).ClearContents
    son_satir = Cells(Rows.Count, "C").End(3).Row
   

    Set rs1 = VBA.CreateObject("adodb.Recordset")
    SORGUU = "SELECT [SD].SAY  from [Sayfa1$] AS [SK]  LEFT OUTER JOIN(SELECT F3 AS [G],COUNT(F3) AS [SAY]  from [Sayfa1$]  GROUP BY F3 ) AS [SD] ON [SD].G=[SK].F3  "
    rs1.Open SORGUU, con
    Range("E1").CopyFromRecordset rs1
    Range("e1") = "Sayı"
   
    With Application
    .ScreenUpdating = True
    End With
    MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub


Vedat bey desteğiniz için teşekkürler göndermiş olduğum dosya üzerinden oldu ama excel bir kaç tane daha sütun eklemek zorunda kaldım.

Seri numarasının olduğu sütun J sayımın yazılması gereken alanda S sütunu oldu makronun bu şekilde çalışması için hangi alanları değiştirmem gerekmektedir.
Kullanıcı avatarı
M-a-d
 
Kayıt: 17 Oca 2019 16:23
Meslek: Satış Sonrası
Yaş: 31
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Ümraniye

Cevap: Aynı Metin/Rakamları Saydırma

İleti#9)  Vedat ÖZER » 12 Mar 2019 15:36

Merhaba,

Kodu aşağıdaki şekilde değiştirip deneyebilir misiniz.


Kod: Tümünü seç
Sub SAY()
   
    Dim son_satir&
    Zaman = Timer
    With Application
    .ScreenUpdating = False
    End With

    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    Range("E2:L" & Rows.Count).ClearContents
    son_satir = Cells(Rows.Count, "C").End(3).Row
   

    Set rs1 = VBA.CreateObject("adodb.Recordset")
    SORGUU = "SELECT [SD].SAY  from [Sayfa1$] AS [SK]  LEFT OUTER JOIN(SELECT F10 AS [G],COUNT(F10) AS [SAY]  from [Sayfa1$]  GROUP BY F10 ) AS [SD] ON [SD].G=[SK].F10  "
    rs1.Open SORGUU, con
    Range("s1").CopyFromRecordset rs1
    Range("s1") = "Sayı"
   
    With Application
    .ScreenUpdating = True
    End With
    MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya

Cevap: Cevap: Aynı Metin/Rakamları Saydırma

İleti#10)  M-a-d » 12 Mar 2019 15:43

Vedat ÖZER yazdı:Merhaba,

Kodu aşağıdaki şekilde değiştirip deneyebilir misiniz.


Kod: Tümünü seç
Sub SAY()
   
    Dim son_satir&
    Zaman = Timer
    With Application
    .ScreenUpdating = False
    End With

    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    Range("E2:L" & Rows.Count).ClearContents
    son_satir = Cells(Rows.Count, "C").End(3).Row
   

    Set rs1 = VBA.CreateObject("adodb.Recordset")
    SORGUU = "SELECT [SD].SAY  from [Sayfa1$] AS [SK]  LEFT OUTER JOIN(SELECT F10 AS [G],COUNT(F10) AS [SAY]  from [Sayfa1$]  GROUP BY F10 ) AS [SD] ON [SD].G=[SK].F10  "
    rs1.Open SORGUU, con
    Range("s1").CopyFromRecordset rs1
    Range("s1") = "Sayı"
   
    With Application
    .ScreenUpdating = True
    End With
    MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub



Vedat Bey desteğiniz için teşekkürler.
Kullanıcı avatarı
M-a-d
 
Kayıt: 17 Oca 2019 16:23
Meslek: Satış Sonrası
Yaş: 31
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Ümraniye

Cevap: Aynı Metin/Rakamları Saydırma

İleti#11)  Vedat ÖZER » 12 Mar 2019 15:44

Rica Ederim,
İyi çalışmalar dilerim.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 2 misafir

Bumerang - Yazarkafe