Excel de formüllerden makrolara geçiş

K

khthonik

Katılım
27 Aralık 2010
Mesajlar
46
Excel Vers. ve Dili
Office 2010 TR 64 Bit
Merhaba,
Alttaki linkteki irsaliye excelimdeki IRSDKM sayfasındaki formüllerden kurtulmak istiyorum. Şuan ki mevcut formüllerin makro olarak yazılmasına ihtiyacım vardır. Ben bir şeyler yaptım. Ama çok formül var kafam karıştı, hem de yaptığım makrolar formül gibi çalışmadı..
Giden İrsaliye Takip.xlsm - 387 KB
Saygılar..
 
K

khthonik

Katılım
27 Aralık 2010
Mesajlar
46
Excel Vers. ve Dili
Office 2010 TR 64 Bit
Merhaba,

Alttaki gibi bir şeyler yapmaya çalıştım. Fakat bir hücreye değer yazınca hesaplıyor, değeri silince hesaplamıyor yada şartı uygulamıyor. Sayfada çok formül var. Alttaki kodları sadece bir kısmı için yapabildim. Diğerlerini nasıl yapacağım bilemiyorum. Zaten yazdığım kodlar tam çalışmadığı için devam da edemedim.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Sat As Long
    On Error GoTo son
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set ws1 = Worksheets("IRSDKM")
    Set ws2 = Worksheets("IRSYZR")
    ws1.Unprotect Password:="***"
    ws2.Unprotect Password:="***"
        
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row > 1 Then
        Sat = Target.Row
        Select Case Target.Column

        Case 26 'Z
        
            ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "Z") + ws1.Cells(Sat, "AH") + ws1.Cells(Sat, "AP") + ws1.Cells(Sat, "AX") + ws1.Cells(Sat, "BF")
            
            If ws1.Cells(Sat, "BL") = 0 Then
                ws1.Cells(Sat, "BJ") = "Hiç Gitmedi"
            End If
            
            If ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Tam Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") < ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Kısmi Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") > ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Fazla Gitti"
            End If
            
            
        Case 34 'AH
            ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "Z") + ws1.Cells(Sat, "AH") + ws1.Cells(Sat, "AP") + ws1.Cells(Sat, "AX") + ws1.Cells(Sat, "BF")
            
            If ws1.Cells(Sat, "BL") = 0 Then
                ws1.Cells(Sat, "BJ") = "Hiç Gitmedi"
            End If
            
            If ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Tam Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") < ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Kısmi Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") > ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Fazla Gitti"
            End If
            
            
        Case 42 'AP
            ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "Z") + ws1.Cells(Sat, "AH") + ws1.Cells(Sat, "AP") + ws1.Cells(Sat, "AX") + ws1.Cells(Sat, "BF")
            
            If ws1.Cells(Sat, "BL") = 0 Then
                ws1.Cells(Sat, "BJ") = "Hiç Gitmedi"
            End If
            
            If ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Tam Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") < ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Kısmi Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") > ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Fazla Gitti"
            End If
            
            
        Case 50 'AX
            ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "Z") + ws1.Cells(Sat, "AH") + ws1.Cells(Sat, "AP") + ws1.Cells(Sat, "AX") + ws1.Cells(Sat, "BF")
            
            If ws1.Cells(Sat, "BL") = 0 Then
                ws1.Cells(Sat, "BJ") = "Hiç Gitmedi"
            End If
            
            If ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Tam Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") < ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Kısmi Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") > ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Fazla Gitti"
            End If
            
            
        Case 58 'BF
            ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "Z") + ws1.Cells(Sat, "AH") + ws1.Cells(Sat, "AP") + ws1.Cells(Sat, "AX") + ws1.Cells(Sat, "BF")
            
            If ws1.Cells(Sat, "BL") = 0 Then
                ws1.Cells(Sat, "BJ") = "Hiç Gitmedi"
            End If
            
            If ws1.Cells(Sat, "BL") = ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Tam Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") < ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Kısmi Gitti"
            End If
            
            If ws1.Cells(Sat, "BL") > ws1.Cells(Sat, "L") Then
                ws1.Cells(Sat, "BJ") = "Fazla Gitti"
            End If



        Case 24 'X
            If ws1.Cells(Sat, "X") = "Hold" Then
                ws1.Cells(Sat, "BJ") = "Tam Hold"
            End If
            
            If ws1.Cells(Sat, "X") = "Direkt" Then
                ws1.Cells(Sat, "BJ") = "Tam Direkt"
            End If
            
            If ws1.Cells(Sat, "X") = "İptal" Then
                ws1.Cells(Sat, "BJ") = "Tam İptal"
            End If
            
            If ws1.Cells(Sat, "X") = ws2.Range("$A$2") Then
                ws1.Cells(Sat, "BN") = 1
            End If
            
            ws1.Cells(Sat, "BS") = ws1.Cells(Sat, "BN") + ws1.Cells(Sat, "BO") + ws1.Cells(Sat, "BP") + ws1.Cells(Sat, "BQ") + ws1.Cells(Sat, "BR")
            
        Case 32 'AF
            If ws1.Cells(Sat, "AF") = "Hold" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Hold"
            End If
            
            If ws1.Cells(Sat, "AF") = "Direkt" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Direkt"
            End If
            
            If ws1.Cells(Sat, "AF") = "İptal" Then
                ws1.Cells(Sat, "BJ") = "Kısmi İptal"
            End If
            
            If ws1.Cells(Sat, "AF") = ws2.Range("$A$2") Then
            ws1.Cells(Sat, "BO") = 1
            End If
            
            ws1.Cells(Sat, "BS") = ws1.Cells(Sat, "BN") + ws1.Cells(Sat, "BO") + ws1.Cells(Sat, "BP") + ws1.Cells(Sat, "BQ") + ws1.Cells(Sat, "BR")
            
        Case 40 'AN
            If ws1.Cells(Sat, "AN") = "Hold" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Hold"
            End If
            
            If ws1.Cells(Sat, "AN") = "Direkt" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Direkt"
            End If
            
            If ws1.Cells(Sat, "AN") = "İptal" Then
                ws1.Cells(Sat, "BJ") = "Kısmi İptal"
            End If
            
            If ws1.Cells(Sat, "AN") = ws2.Range("$A$2") Then
                ws1.Cells(Sat, "BP") = 1
            End If
            
            ws1.Cells(Sat, "BS") = ws1.Cells(Sat, "BN") + ws1.Cells(Sat, "BO") + ws1.Cells(Sat, "BP") + ws1.Cells(Sat, "BQ") + ws1.Cells(Sat, "BR")
            
        Case 48 'AV
            If ws1.Cells(Sat, "AV") = "Hold" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Hold"
            End If
            
            If ws1.Cells(Sat, "AV") = "Direkt" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Direkt"
            End If
            
            If ws1.Cells(Sat, "AV") = "İptal" Then
                ws1.Cells(Sat, "BJ") = "Kısmi İptal"
            End If
            
            If ws1.Cells(Sat, "AV") = ws2.Range("$A$2") Then
                ws1.Cells(Sat, "BQ") = 1
            End If
            
            ws1.Cells(Sat, "BS") = ws1.Cells(Sat, "BN") + ws1.Cells(Sat, "BO") + ws1.Cells(Sat, "BP") + ws1.Cells(Sat, "BQ") + ws1.Cells(Sat, "BR")
            
        Case 56 'BD
            If ws1.Cells(Sat, "BD") = "Hold" Then
                ws1.Cells(Satir, "BJ") = "Kısmi Hold"
            End If
            
            If ws1.Cells(Sat, "BD") = "Direkt" Then
                ws1.Cells(Sat, "BJ") = "Kısmi Direkt"
            End If
            
            If ws1.Cells(Sat, "BD") = "İptal" Then
                ws1.Cells(Sat, "BJ") = "Kısmi İptal"
            End If
            
            If ws1.Cells(Sat, "BD") = ws2.Range("$A$2") Then
                ws1.Cells(Sat, "BR") = 1
            End If
            
            ws1.Cells(Sat, "BS") = ws1.Cells(Sat, "BN") + ws1.Cells(Sat, "BO") + ws1.Cells(Sat, "BP") + ws1.Cells(Sat, "BQ") + ws1.Cells(Sat, "BR")

'With Worksheets("IRSDKM")
 '.Protect Password:="***", userinterfaceonly:=True, AllowFiltering:=True
 '.EnableOutlining = True
 'End With
 
Application.ScreenUpdating = True
son: Application.EnableEvents = True
End Select
End If

End Sub
 
K

khthonik

Katılım
27 Aralık 2010
Mesajlar
46
Excel Vers. ve Dili
Office 2010 TR 64 Bit
Merhabalar,
Sormuş olduğum excelde makrolarımı hazırladım. Makrolar çalıştı fakat procedure too large hatası aldım. Ekteki exceldeki IRSDKM sayfası modülündeki makrolarımı kısaltabilir yada yol gösterebilir misiniz.
200017 Giden İrsaliye Takip.xlsm - 1.3 MB
Teşekkürler..
 
K

khthonik

Katılım
27 Aralık 2010
Mesajlar
46
Excel Vers. ve Dili
Office 2010 TR 64 Bit
Koruma kaldırılmıştır. IRSDKM sayfasındaki kodların kısaltılması yada call makro ile bir kaç çözüm yada başka bir yol gösterilmesine ihtiyacım vardır. Makrolar çok uzun olduğu için çalıştıramadım..
200019 Giden İrsaliye Takip.xlsm - 1.3 MB
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,828
Excel Vers. ve Dili
2019 Türkçe
Siz IRSDKM adlı sayfada bir değişiklik olduğunda ne olmasını istiyorsunuz?
IRSDKM sayfasındaki kodları silip yeniden yazmak sanki daha kolay olur.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst