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 02-02-2015, 22:22   #11
Ömer
Moderatör
 
Ömer kullanıcısının avatarı
 
Giriş: 18/08/2007
Şehir: Kuşadası
Mesaj: 19,009
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Merhaba,

MsgBox dizi(1, 2) 'dizinin 1. satır 2.sütunundaki elamanı.

İstediğiniz bu mu?
__________________
.
Ömer Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2015, 23:08   #12
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,643
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Oluşan dizideki item değerlerine aşağıdaki gibi ulaşabilirsiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
    Dim d, a, i
    
    Set d = CreateObject("Scripting.Dictionary")
    
    d.Add "www", 1
    d.Add "excel", 2
    d.Add "web", 3
    d.Add "tr", 4
    
    a = d.Keys
    
    For i = 0 To d.Count - 1
        MsgBox a(i)
    Next
    
    Set d = Nothing
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
Eski 02-02-2015, 23:42   #13
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,643
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Dictionary listesi büyük veri yığınlarını çok hızlı bir şekilde derlemektedir. Bunu yaptığım testlerde gözlemledim.

Aşağıdaki kodu boş bir dosyada deneyiniz.

A sütununa 1 den 100.000 e kadar sıra numarası giriniz. Sonra kodu çalıştırıp süreyi gözlemleyiniz.

Daha sonra veri sayısını çoğaltarak süreyi test ediniz.

Ben İ7 işlemci ile 500.000 adet benzersiz veride 12 saniyede sonuç aldım. Benzer kayıt sayısı arttığında ise işlem süresi dahada kısalmaktadır.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
    Dim Dizi, Liste, Zaman, Son, i
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    Liste = Range("A1:A" & Son)
    
    For i = 1 To UBound(Liste, 1)
        If Not Dizi.exists(Liste(i, 1)) Then
            Dizi.Add Liste(i, 1), Nothing
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Benzersiz kayıt sayısı : " & Dizi.Count & Chr(10) & _
           "İşlem süresi : " & Format(Timer - Zaman, "0.00000")
    
    Set Dizi = Nothing
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
Eski 03-02-2015, 12:09   #14
kuvari
Destek Ekibi
 
kuvari kullanıcısının avatarı
 
Giriş: 04/05/2007
Şehir: İstanbul
Mesaj: 2,633
Excel Vers. ve Dili:
OFİS 2013 TÜRKÇE-İNG. 64 BİT
Varsayılan

Korhan bey çok sağolun, çok faydalı bilgiler veriyorsunuz.

Aşağıdaki kodda "a" ları listeledim ama Scripting.Dictionary'i işin içine sokamadım. Onu nasıl yapabilirim.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Base 1
Sub BENZERSİZ_ÇİFT_SÜTUN()
On Error Resume Next
    Dim s As Object, liste(), dizi()
    
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
    
    ReDim dizi(1 To Son, 1 To 2)
    
    Set s = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(liste, 1)
        aranan = liste(i, 1)
       If aranan = "a" Then
    '    If Not s.exists(aranan) Then
            s.Add aranan, Nothing
            Say = Say + 1
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
            dizi(Say, 2) = liste(i, 2)
        'End If
        End If
    Next i
    
    Sheets(2).Range("A2").Resize(UBound(dizi), 2) = (dizi)
End Sub
__________________
Bilgi kadar zenginlik, cehalet kadar yoksulluk yoktur.
(Hz. Ali)
kuvari Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-02-2015, 02:27   #15
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,643
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Dictionary nesnesi verileri benzersiz mantığı ile biriktirir. Siz tekrar eden bir değere bakarak liste oluşturmak istiyorsunuz. Bu nedenle Dictionary nesnesini kullanmanıza gerek yok. Dizi yöntemiyle hızlıca sonuca gidebilirsiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
    Dim Liste(), Zaman, Son, Say, i
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    Liste = Range("A1:B" & Son)
    
    ReDim Veri(1 To Son, 1 To 2)
    
    For i = 1 To UBound(Liste, 1)
        If Liste(i, 1) = "a" Then
            Say = Say + 1
            ReDim Preserve Veri(1 To Son, 1 To 2)
            Veri(Say, 1) = Liste(i, 1)
            Veri(Say, 2) = Liste(i, 2)
        End If
    Next
    
    Range("E:F").ClearContents
    Range("E1").Resize(Say, 2) = Veri
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşlem süresi : " & Format(Timer - Zaman, "0.00000")
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
Eski 08-02-2015, 14:59   #16
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Alıntı:
Korhan Ayhan tarafından gönderildi Mesajı Görüntüle
Aşağıdaki kod ise tek sütundaki benzersizleri listelerken ikinci sütundaki verileri toplayarak rapor oluşturur. Yani bir nevi özet tablo gibi çalışır.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub BENZERSİZ_TEK_SÜTUN_TOPLAMALI()
    Dim s As Object, liste(), dizi()
    
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
    
    ReDim dizi(1 To Son, 1 To 1)
    
    Set s = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(liste, 1)
        Aranan = liste(i, 1)
        If Not s.exists(Aranan) Then
            Say = Say + 1
            s.Add Aranan, Say
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
        End If
        dizi(s.Item(Aranan), 2) = dizi(s.Item(Aranan), 2) + liste(i, 2)
    Next i
    
    Sheets(2).Range("A2").Resize(s.Count, 2) = dizi
End Sub
Merhabalar Sayın AYHAN, bu konudaki mesaj ve açıklamalardan anladığım
kadarıyla, benim derdimin çözümü de bu kodlardan geçiyor, birkaç eksiğine
rağmen sizlerin katkılarıyla oluşturduğum ekteki excel belgeme bir göz atabilir misiniz acaba?

Mevcut belgemde sonuç almam 100-110 saniye sürüyor.
Eğer sizin buradaki kodlarınızı kullanabilseydim birkaç saniyede sonuç alacağımı sanıyorum.

Ekteki excel belgesinin, birkaç gizli sayfa ve yerleşik fonksiyonları kullanan makroların
NİHAİ AMACI, TABLO1 sayfasında
-- E2 (veri doğrulama seçimine göre F4:AU4 aralığı oluşturuluyor),
--E3 (veri doğrulama seçimine göre F3:AU3 aralığı oluşturuluyor) VE
--E4
(veri doğrulama seçimine göre E8:E17 aralığı oluşturuluyor)
hücrelerindeki seçimlere göre oluşan tablo sütun ve satır başlıklarına göre LİSTE sayfasının;

1) koşullara uyan satırlarında, C sütunundaki
BENZERSİZ VERİ SAYIMININ,

2) koşullara uyan SATIR SAYIMININ

yapılması ve TABLO1 sayfasında satır ve sütun başlıklarına göre ilgili alanlara yazılması.

NOT : Belgemdeki mevcut makro ve sayfaların çalışma mantığını; LİSTE ve TABLO1 sayfalarındaki
METİN KUTULARINDA ve SEÇİM sayfası Q ve R sütunlarında elimden geldiğince anlaşılır şekilde açıkladım.
Eklenmiş Dosyalar
Dosya Türü: xlsm DR.06.02.15.DESTEK.xlsm (1.65 MB, 29 Görüntülenme)
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.

Bu mesaj en son " 14-02-2015 " tarihinde saat 22:02 itibariyle Ömer BARAN tarafından düzenlenmiştir....
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-02-2015, 22:21   #17
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

CreateObject("Scripting.Dictionary") yöntemini kullanarak, bir üstteki mesajımda yer alan belgemi açıp mevcut makro çalıştırıldığında alınan sonuçlara, çok kısa sürede ulaşılacağını düşündüğümden destek rica etmiştim.
Sayın AYHAN veya konuyu bilen bir üye ilgilenirse sevinirim.
Yapılacak işlem liste sayfası DR sütununda, TABLO1 sayfamdaki satır ve sütun başlıklarına göre ilgili sütunlardaki bilgiler, aralara " | " eklenerek metne dönüştürülmesi halinde (bu dönüştürme işlemi belgemdeki SAYIM2 makrosuna kadarki kısımda gerçekleşiyor) bulunduğu satırlarda C sütunundaki farklı değer sayısı ile eşleşmenin olduğu satır sayısının TABLO1 sayfasında F5 : AU17 aralığına yazdırılması gerekiyor.
Örnek dosyamda TABLO1 sayfasındaki düğme kullanılarak mevcut makrolar çalıştırıldığında oluşan makro sonuçlarından anlaşılacağını düşünüyorum.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.

Bu mesaj en son " 15-02-2015 " tarihinde saat 20:13 itibariyle Ömer BARAN tarafından düzenlenmiştir....
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-02-2015, 00:19   #18
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,643
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Merhaba Ömer Bey,

Eklemiş olduğunuz dosyanıza boş bir sayfa ekleyin. Adı "Sayfa1" olsun.

Daha sonra diğer sayfanızdan seçimlerinizi yaptıktan sonra aşağıdaki kodu deneyin.

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

Sub ÖZET_TABLO()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Zaman As Double, Son As Long, Nesne As Object, Liste()
    Dim Sutun1 As String, Sutun2 As String, Sutun3 As String
    Dim X As Long, Kriter As String, Say As Long
    Dim Tablo As PivotTable, Sutun As PivotField
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("TABLO1")
    Set S3 = Sheets("Sayfa1")
    
    S3.Cells.Clear
    
    On Error Resume Next
    Son = S1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Son = 0 Then Son = 100000
    On Error GoTo 0
    
    Sutun1 = S2.Range("AG2")
    Sutun2 = S2.Range("AH2")
    Sutun3 = S2.Range("AI2")
    
    S3.Range(S3.Cells(1, 1), S3.Cells(Son - 6, 1)) = S1.Range(S1.Cells(7, Sutun2), S1.Cells(Son, Sutun2)).Value2
    S3.Range(S3.Cells(1, 2), S3.Cells(Son - 6, 2)) = S1.Range(S1.Cells(7, Sutun1), S1.Cells(Son, Sutun1)).Value2
    S3.Range(S3.Cells(1, 3), S3.Cells(Son - 6, 3)) = S1.Range(S1.Cells(7, Sutun3), S1.Cells(Son, Sutun3)).Value2
    S3.Range(S3.Cells(1, 4), S3.Cells(Son - 6, 4)) = S1.Range(S1.Cells(7, 3), S1.Cells(Son, 3)).Value2

    Set Nesne = CreateObject("Scripting.Dictionary")

    Liste = S3.Range("A1").CurrentRegion.Resize(, 4).Value
    ReDim Dizi(1 To 4, 1 To 1)
    
    For X = 1 To UBound(Liste, 1)
        Kriter = Liste(X, 1) & "#" & Liste(X, 2) & "#" & Liste(X, 3) & "#" & Liste(X, 4)
        If Not Nesne.Exists(Kriter) Then
            Say = Say + 1
            Nesne.Add Kriter, Say
            ReDim Preserve Dizi(1 To 4, 1 To Say)
            Dizi(1, Say) = Liste(X, 1)
            Dizi(2, Say) = Liste(X, 2)
            Dizi(3, Say) = Liste(X, 3)
            Dizi(4, Say) = Liste(X, 4)
        End If
    Next
        
    S3.Range("A1").Select
    S3.Range("A1").Resize(Rows.Count, 4).ClearContents
    S3.Range("A1").Resize(Say, 4) = Application.Transpose(Dizi)
        
    Set Tablo = S3.PivotTableWizard(, , S3.Range("H1"))
    Set Sutun = Tablo.PivotFields(S3.Range("A1").Text)
    Sutun.Orientation = xlColumnField
    Set Sutun = Tablo.PivotFields(S3.Range("B1").Text)
    Sutun.Orientation = xlColumnField
    Set Sutun = Tablo.PivotFields(S3.Range("C1").Text)
    Sutun.Orientation = xlRowField
    Set Sutun = Tablo.PivotFields("Hasta No")
    Sutun.Orientation = xlDataField
    Sutun.Function = xlCount
    
    S3.Cells.EntireColumn.AutoFit

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00000")
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
Eski 09-11-2017, 11:45   #19
KarıncaZ
 
KarıncaZ kullanıcısının avatarı
 
Giriş: 22/01/2006
Şehir: KOCAELİ
Mesaj: 207
Excel Vers. ve Dili:
Office 2003 , 2013 ve 2016 TR.
Varsayılan Scripting.Dictionary yardım.

Merhaba.

Konuyu araştırdım yazılanları da okudum ancak bir türlü yapamadım.
Linkdeki dosyada çalışan makroların Scripting.Dictionary ile yada daha hızlı sonuç verecek bir yöntemle yapılması mümkün mü?

Veri sayısı çok fazla. Ben verilerin yarısını ekleyerek örnek dosyayı hazırladım.

http://s5.dosya.tc/server5/v44sbr/Es...rlama.zip.html

İkiTarihMizan Sayfasında şekillere atadığım makroların kısa sürede gerçekleşmesi çok önemli. Benim yazdıklarımın sonuçlanması çok uzun sürüyor bazende excel yanıt vermediği için kapatmak zorunda kalıyorum. Yevmiye sayfasında şekillere atadığım makroların sonuçlanması nispeten kabul edile bilir sürede.

Yardımlarınız için şimdiden teşekkürler.
__________________
Excel 2003 - 2007 - 2010 - 2013 - 2016 Türkçe
KarıncaZ Çevrimdışı   Alıntı Yaparak Cevapla
Eski 11-11-2017, 00:34   #20
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 394
Excel Vers. ve Dili:
office2010
Varsayılan

Merhaba,

İkiTarihMizan sayfasında [C, D, E, F] sütunları için kodu bu şekilde kullanın.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub CommandButton1_Click()
Z = TimeValue(Now)
Application.ScreenUpdating = False
Set s1 = Sheets("Yevmiye")
Set s2 = Sheets("İkiTarihMizan")
Set d = CreateObject("scripting.dictionary")
ss1 = s1.Cells(Rows.Count, 1).End(xlUp).Row
ss2 = s2.Cells(Rows.Count, 1).End(xlUp).Row
trh1 = CDate(s2.[A1])
trh2 = CDate(s2.[A2])
a = s1.Range("A2:M" & ss1)
ReDim b(1 To UBound(a), 1 To 8)

For i = 1 To UBound(a)
    If a(i, 2) >= trh1 And a(i, 2) <= trh2 Then
        veri = a(i, 4)
        If Not d.exists(veri) Then
            say = say + 1
            d(a(i, 4)) = say
            If Len(veri) >= 3 Then b(say, 1) = Left((veri), 3)
            If Len(veri) >= 6 Then b(say, 2) = Left((veri), 6)
            If Len(veri) >= 7 Then b(say, 3) = Left((veri), 7)
            If Len(veri) >= 9 Then b(say, 4) = Left(veri, 9)
            If Len(veri) >= 10 Then b(say, 5) = Left(veri, 10)
            If Len(veri) >= 11 Then b(say, 6) = Left(veri, 11)
        End If
        sat = d(a(i, 4))
        b(sat, 7) = b(sat, 7) + a(i, 7)
        b(sat, 8) = b(sat, 8) + a(i, 8)
    End If
Next i
'****************************************************************

tbl = Array(b)
Erase b
d.RemoveAll
ReDim b(1 To say*2, 1 To 3)

For i = 1 To say
    For j = 1 To 6
        veri = CStr(tbl(0)(i, j))
        If Not IsEmpty(veri) Then
            If Not d.exists(veri) Then
                say1 = say1 + 1
                d(veri) = say1
                b(say1, 1) = CStr(veri)
            End If
            b(d(veri), 2) = b(d(veri), 2) + tbl(0)(i, 7)
            b(d(veri), 3) = b(d(veri), 3) + tbl(0)(i, 8)
        End If
    Next j
Next i
'****************************************************************

k = s2.Range("A4:A" & ss2)
On Error Resume Next
ReDim c(1 To UBound(k), 1 To 4)

For i = 1 To UBound(k)
    n = n + 1
    c(n, 1) = 0
    c(n, 2) = 0
    c(n, 3) = 0
    c(n, 4) = 0
    c(n, 1) = b(d(CStr(k(i, 1))), 2)
    c(n, 2) = b(d(CStr(k(i, 1))), 3)
    If b(d(CStr(k(i, 1))), 2) > b(d(CStr(k(i, 1))), 3) Then
        c(n, 3) = b(d(CStr(k(i, 1))), 2) - b(d(CStr(k(i, 1))), 3)
    Else
        c(n, 4) = b(d(CStr(k(i, 1))), 3) - b(d(CStr(k(i, 1))), 2)
    End If
Next i
'*************************************************************************

s2.[C4].Resize(n, 4) = c
s2.[C4].Resize(n, 4).NumberFormat = "#,##0.00"
Application.ScreenUpdating = True
MsgBox CDate(TimeValue(Now) - Z)
End Sub

https://www.dosyaupload.com/54w6

Bu mesaj en son " 11-11-2017 " tarihinde saat 00:44 itibariyle Ziynettin tarafından düzenlenmiştir....
Ziynettin Ç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 14:59


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