- Katılım
- 12 Eylül 2021
- Mesajlar
- 45
- Excel Vers. ve Dili
- Microsoft Office 2016 Türkçe
- Altın Üyelik Bitiş Tarihi
- 01-03-2024
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub ozet()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set S1 = Sheets("DATA")
Set S2 = Sheets("RAPOR")
Set Dizi = CreateObject("Scripting.Dictionary")
S2.Range("A2:C" & S2.Rows.Count).Clear
Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
Veri = S1.Range("A2:K" & Son).Value
ReDim Liste(1 To Son, 1 To 3)
For X = LBound(Veri) To UBound(Veri)
Aranan = Veri(X, 2)
If Not Dizi.Exists(Aranan) Then
Say = Say + 1
Dizi.Add Aranan, Say
Liste(Say, 1) = Veri(X, 2)
Liste(Say, 2) = Veri(X, 11)
If Veri(X, 11) < 0 Then
Liste(Say, 3) = "fazla"
Else
Liste(Say, 3) = "eksik"
End If
Else
Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11)
If Liste(Dizi.Item(Aranan), 2) < 0 Then
Liste(Dizi.Item(Aranan), 3) = "fazla"
Else
Liste(Dizi.Item(Aranan), 3) = "eksik"
End If
End If
Next
If Say > 0 Then
S2.Range("A2").Resize(Say, 3) = Liste
S2.Range("A2").Resize(Say, 3).Sort S2.Range("A2"), xlAscending
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Else
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "veri bulunamadı!" & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbExclamation
End If
Set S1 = Nothing
Set S2 = Nothing
Set Dizi = Nothing
End Sub
Çok teşekkür ederim. İstediğim gibi olmuş. Bunu Mülkiyet sahibine göre düzenleye bilirmiyiz. Örneğin Etinin malzemesi ülkerin malzemesine karışmaması gerekiyor.Merhaba,
Dosya ekte mevcuttur
C#:Sub ozet() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set S1 = Sheets("DATA") Set S2 = Sheets("RAPOR") Set Dizi = CreateObject("Scripting.Dictionary") S2.Range("A2:C" & S2.Rows.Count).Clear Son = S1.Cells(S1.Rows.Count, 1).End(3).Row Veri = S1.Range("A2:K" & Son).Value ReDim Liste(1 To Son, 1 To 3) For X = LBound(Veri) To UBound(Veri) Aranan = Veri(X, 2) If Not Dizi.Exists(Aranan) Then Say = Say + 1 Dizi.Add Aranan, Say Liste(Say, 1) = Veri(X, 2) Liste(Say, 2) = Veri(X, 11) If Veri(X, 11) < 0 Then Liste(Say, 3) = "fazla" Else Liste(Say, 3) = "eksik" End If Else Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11) If Liste(Dizi.Item(Aranan), 2) < 0 Then Liste(Dizi.Item(Aranan), 3) = "fazla" Else Liste(Dizi.Item(Aranan), 3) = "eksik" End If End If Next If Say > 0 Then S2.Range("A2").Resize(Say, 3) = Liste S2.Range("A2").Resize(Say, 3).Sort S2.Range("A2"), xlAscending Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Else Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True MsgBox "veri bulunamadı!" & Chr(10) & Chr(10) & _ "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbExclamation End If Set S1 = Nothing Set S2 = Nothing Set Dizi = Nothing End Sub
Sub ozet()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set S1 = Sheets("DATA")
Set S2 = Sheets("RAPOR")
Set Dizi = CreateObject("Scripting.Dictionary")
S2.Range("A2:D" & S2.Rows.Count).Clear
Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
Veri = S1.Range("A2:K" & Son).Value
ReDim Liste(1 To Son, 1 To 4)
For X = LBound(Veri) To UBound(Veri)
Aranan = Veri(X, 2) & Veri(X, 1)
If Not Dizi.Exists(Aranan) Then
Say = Say + 1
Dizi.Add Aranan, Say
Liste(Say, 1) = Veri(X, 2)
Liste(Say, 2) = Veri(X, 11)
If Veri(X, 11) < 0 Then
Liste(Say, 3) = "fazla"
Else
Liste(Say, 3) = "eksik"
End If
Liste(Say, 4) = Veri(X, 1)
Else
Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11)
If Liste(Dizi.Item(Aranan), 2) < 0 Then
Liste(Dizi.Item(Aranan), 3) = "fazla"
Else
Liste(Dizi.Item(Aranan), 3) = "eksik"
End If
End If
Next
If Say > 0 Then
S2.Range("A2").Resize(Say, 4) = Liste
S2.Range("A2").Resize(Say, 4).Sort S2.Range("A2"), xlAscending
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Else
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "veri bulunamadı!" & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbExclamation
End If
Set S1 = Nothing
Set S2 = Nothing
Set Dizi = Nothing
End Sub