Kuvvetli formül ve Exelde Donma sorunu

[aktarmamd]

Ü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.

 

[ÖmerFaruk]

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?

 

[aktarmamd]

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?

Üstad;
Data daki verilerden almamız gerekiyor.

 

[ÖmerFaruk]

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

 

[aktarmamd]

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

Evet üstad malesef boş olanlar var. Onları hesaba katmaması lazım İl/İlçe eşleşiyorsa hesaplamalı

 

[Ziynettin]

Kodu boş module yapıştırın.

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

 

[aktarmamd]

Kodu boş module yapıştırın.

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

Üstad kodu kullandım ama İşlem süresi şu kadar diyor.. Ama spreadshette bir hesaplama yapmıyor.

 

[Ziynettin]

Çalıştığım dosya.

 

[aktarmamd]

Çalıştığım dosya.

Üstad kod çalıştı fakat hesaplama sonuçları hep sıfır.

 

[Ziynettin]

Sıfırlar(0) boş sonuç yaz(i, j) = 0 kod satırını pasif edin yada silin ve gelen sonuçları kontrol ediniz.

 

[İdris SERDAR]

.

Bu tarz işinize yarar mı?

.

 

[aktarmamd]

.

Bu tarz işinize yarar mı?

.

Hocam emeğiniz için teşekkürler ama ihtiyacım olan esasında Hangi İl/İlçeden Hangi İl/ilçeye kaç adet ürün gitmiş bu çaprazları hesaplamak. Formülle yaptığımda da dosya kilitleniyor.

 

[Ziynettin]

#8. iletideki dosyayı tekrar deneyin.

 

[aktarmamd]

#8. iletideki dosyayı tekrar deneyin.

Üstad tek hücrede hesaplama yapıyor, tüm tabloyu nasıl hesaplatabilirim. Kod konusunda çok iyi değilim..

 

[Ziynettin]

Ekli dosyada
X16=4
X34=1
AH19... AO25 arasında hesap sonuçları geliyor.

Ya da sorunuzu ben mi anlamadım.

 

[aktarmamd]

Ekli dosyada
X16=4
X34=1
AH19... AO25 arasında hesap sonuçları geliyor.

Ya da sorunuzu ben mi anlamadım.

Ü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.