• DİKKAT

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

Kuvvetli formül ve Exelde Donma sorunu

aktarmamd

aktarmamd

Katılım
29 Aralık 2013
Mesajlar
218
Excel Vers. ve Dili
Office Exel 2016
Üstadlar Merhaba;

Ek te örneği olan basit bir çokeğersay formülünü yüklü veri olan dosyada çalıştırmak istediğimde ya saatlerce beklemek yada kızıp kapatmam gerekiyor. Araştırmalaraım bu işin makro ile çözüleceği bilgisi veriyor. Amacım data sayfasındaki verileri makro ile diğer sayfadaki tabloya getirebilme bu sorgu ile de yapılabiliyor mu bilmiyorum ama en hızlı şekilde bunun gibi onlarca sayfalık veriden tablolar oluşturmam gerekiyor.

Örnek çalışma kitabındaki sheet1sayfasında çıkış-varış il/ilçe verileri olan tabloyu B sütunundaki adede göre saydırmam veya toplatıp düzgünce sayıları tablolalamam lazım destek olacak arkadaşlar şimdiden teşekkürler.
 

Ekli dosyalar

  • 3.xlsx
    3.xlsx
    600 KB · Görüntüleme: 17
Spreadsheet sayfasında Bazı çıkış ve varış il ve ilçeleri yok.
Bunları DATA sayfasından mı oluşturacağız yoksa mevcut Spreadsheet sayfasındaki tabloyu olduğu gibi mi kullanacağız?
 
NextLevel' Alıntı:
Spreadsheet sayfasında Bazı çıkış ve varış il ve ilçeleri yok.
Bunları DATA sayfasından mı oluşturacağız yoksa mevcut Spreadsheet sayfasındaki tabloyu olduğu gibi mi kullanacağız?
Genişletmek için tıkla ...
Üstad;
Data daki verilerden almamız gerekiyor.
 
Spreadsheet sayfasında Bazı çıkış ve varış il ve ilçeleri yok.
Bu konu ne olacak
Örnek
29.satır Ankara.. ilçe yok
40.satır İstanbul..ilçe yok
 
NextLevel' Alıntı:
Spreadsheet sayfasında Bazı çıkış ve varış il ve ilçeleri yok.
Bu konu ne olacak
Örnek
29.satır Ankara.. ilçe yok
40.satır İstanbul..ilçe yok
Genişletmek için tıkla ...
Evet üstad malesef boş olanlar var. Onları hesaba katmaması lazım İl/İlçe eşleşiyorsa hesaplamalı
 
Kodu boş module yapıştırın.

Kod: 
Sub test()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim vX(), vY(), yaz()
Z = TimeValue(Now)
Set WS1 = Sheets("data")
Set WS2 = Sheets("spreadsheet")
bas = Val(WS1.[A2])
bit = Val(WS1.[B2])
Set dc = CreateObject("scripting.dictionary")
son = WS1.Cells(Rows.Count, 1).End(3).Row
a = WS1.Range("A1:H" & son).Value
For i = 2 To UBound(a)
    If a(i, 8) >= bas And a(i, 8) <= bit Then
    krt = Byk((a(i, 3))) & "|" & Byk((a(i, 4))) & "|" & _
          Byk((a(i, 5))) & "|" & Byk((a(i, 6)))
    dc(krt) = dc(krt) + 1
    End If
Next i

sut = WS2.Rows(2).Find("*", , , , xlByColumns, xlPrevious).Column - 3
If sut > 0 Then
sat = WS2.Columns(2).Find("*", , , , xlByRows, xlPrevious).Row
vX = WS2.Range("B4:C" & sat).Value
vY = WS2.[D2].Resize(2, sut).Value
ReDim yaz(1 To UBound(vX), 1 To UBound(vY, 2))
    For i = 1 To UBound(vX)
        For j = 1 To UBound(vY, 2)
            vxy = Byk((vX(i, 1))) & "|" & Byk((vX(i, 2))) & "|" & _
                  Byk((vY(1, j))) & "|" & Byk((vY(2, j)))
            If dc(vxy) Then
                yaz(i, j) = dc(vxy)
            Else
                'yaz(i, j) = 0
            End If
        Next j
    Next i
WS2.[D4].Resize(UBound(vX), UBound(vY, 2)) = yaz
End If
MsgBox "İşlem süerniz." & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub
Function Byk(deg As String)
deg = UCase(Replace(Replace(deg, "i", "İ"), "ı", "I"))
Byk = deg
End Function
 
Ziynettin' Alıntı:
Kodu boş module yapıştırın.

Kod: 
Sub test()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim vX(), vY(), yaz()
Z = TimeValue(Now)
Set WS1 = Sheets("data")
Set WS2 = Sheets("spreadsheet")
bas = Val(WS1.[A2])
bit = Val(WS1.[B2])
Set dc = CreateObject("scripting.dictionary")
son = WS1.Cells(Rows.Count, 1).End(3).Row
a = WS1.Range("A1:H" & son).Value
For i = 2 To UBound(a)
    If a(i, 8) >= bas And a(i, 8) <= bit Then
    krt = Byk((a(i, 3))) & "|" & Byk((a(i, 4))) & "|" & _
          Byk((a(i, 5))) & "|" & Byk((a(i, 6)))
    dc(krt) = dc(krt) + 1
    End If
Next i

sut = WS2.Rows(2).Find("*", , , , xlByColumns, xlPrevious).Column - 3
If sut > 0 Then
sat = WS2.Columns(2).Find("*", , , , xlByRows, xlPrevious).Row
vX = WS2.Range("B4:C" & sat).Value
vY = WS2.[D2].Resize(2, sut).Value
ReDim yaz(1 To UBound(vX), 1 To UBound(vY, 2))
    For i = 1 To UBound(vX)
        For j = 1 To UBound(vY, 2)
            vxy = Byk((vX(i, 1))) & "|" & Byk((vX(i, 2))) & "|" & _
                  Byk((vY(1, j))) & "|" & Byk((vY(2, j)))
            If dc(vxy) Then
                yaz(i, j) = dc(vxy)
            Else
                'yaz(i, j) = 0
            End If
        Next j
    Next i
WS2.[D4].Resize(UBound(vX), UBound(vY, 2)) = yaz
End If
MsgBox "İşlem süerniz." & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub
Function Byk(deg As String)
deg = UCase(Replace(Replace(deg, "i", "İ"), "ı", "I"))
Byk = deg
End Function
Genişletmek için tıkla ...
Üstad kodu kullandım ama İşlem süresi şu kadar diyor.. Ama spreadshette bir hesaplama yapmıyor.
 
Sıfırlar(0) boş sonuç yaz(i, j) = 0 kod satırını pasif edin yada silin ve gelen sonuçları kontrol ediniz.
 
#8. iletideki dosyayı tekrar deneyin.
 
Ekli dosyada
X16=4
X34=1
AH19... AO25 arasında hesap sonuçları geliyor.

Ya da sorunuzu ben mi anlamadım.
 
Ziynettin' Alıntı:
Ekli dosyada
X16=4
X34=1
AH19... AO25 arasında hesap sonuçları geliyor.

Ya da sorunuzu ben mi anlamadım.
Genişletmek için tıkla ...
Üstad Ellerine sağlık ben tam incelemeden dönmüşüm.. Şu an İşim çözüldü emeği geçen herkese teşekkürler. Birkaç geliştirmeye daha ihtiyacım olacaktır muhakkak o zaman tekrar uzmanlığınıza başvurabilirim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst