• DİKKAT

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

otomatik dizi formülü onayı

Katılım
18 Ağustos 2009
Mesajlar
752
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Arkadaşlar bir butonumda formumdaki verileri temizlettiriyorum ve sonrasında bazı hücrelerimde dizi formülü olduğundan sonuna örneğin

={TOPLA((L3:L11="UFUK")*(M3:M11))+TOPLA((L42:L70="UFUK")*(M42:M70))+TOPLA((L81:L136="UFUK")*(M81:M136))+100} +100 eklentiğinden dolayı +100'silerek yeniden CTRL+SHIFT+ENTER ile komut vermek zorunda kalıyorum. Dizi formülü olan alanım D149:E158 aralığındaki hücrelerdir. Bu alana aşağıdaki temizleme macromun sonuna nasıl bir eklenti yaparak CTRL+SHIFT+ENTER komutu verebilirim?

Teşekkürler...


Private Sub CommandButton15_Click()
Dim sifre
sifre = InputBox("Lütfen Şifre Giriniz")
If sifre = "123" Then
ActiveWindow.SmallScroll Down:=-3
Range("M3:N11").Select
Selection.ClearContents
Range("P3:11").Select
Selection.ClearContents
Range("M13:N40").Select
Selection.ClearContents
Range("P13:40").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=33
Range("M42:N73").Select
Selection.ClearContents
Range("P42:73").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=36
Range("M81:N136").Select
Selection.ClearContents
Range("P81:136").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-138
ActiveWindow.SmallScroll ToRight:=8
Range("W4:X9").Select
Selection.ClearContents
Range("Z4:Z9").Select
Selection.ClearContents
Range("AB4:AB14").Select
Selection.ClearContents
Range("AD4:AD24").Select
Selection.ClearContents
Range("AF4:AF25").Select
Selection.ClearContents
Range("Z13:Z15").Select
Selection.ClearContents
Range("AA20").Select
Selection.ClearContents
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 1
Range("P1:Q1").Select
If numlock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
Else
MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
End If
End Sub
 
Merhaba.
Madem kod kullanıyorsunuz o zaman formül yerine kod ile işlem yapmak daha doğru olabilir.
Tam olarak ne yapmak istediğinizi yazarsanız ve mümkünse örnek bir dosya da ekleyin, yardımcı olmaya çalışalım.

Ayrıca, yukarıdaki kodun yaptığı işi aşağıdaki ile yapabilirsiniz.

Kod:
Private Sub CommandButton15_Click()
    Dim sifre
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then
        Range("M3:N11,P3:Q11,M13:N40,M42:N73,M81:N136,W4:X9,Z4:Z9,AB4:AB14,AD4:AD24,AF4:AF25,Z13:Z15,AA20").ClearContents
        If numlock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
    Else
        MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
End Sub
 
Son düzenleme:
Merhaba.
Madem kod kullanıyorsunuz o zaman formül yerine kod ile işlem yapmak daha doğru olabilir.
Tam olarak ne yapmak istediğinizi yazarsanız ve mümkünse örnek bir dosya da ekleyin, yardımcı olmaya çalışalım.

Ayrıca, yukarıdaki kodun yaptığı işi aşağıdaki ile yapabilirsiniz.

Kod:
Private Sub CommandButton15_Click()
    Dim sifre
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then
        ActiveWindow.SmallScroll Down:=-3
        Range("M3:N11,P3:Q11,M13:N40,M42:N73,M81:N136,W4:X9,Z4:Z9,AB4:AB14,AD4:AD24,AF4:AF25,Z13:Z15,AA20").ClearContents
        If numlock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
    Else
        MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
End Sub


Öncelikle teşekkürler hocam. Amacım D149,D150,D151,D152,D153,D155,D156,E149,E150,E151,E152,E153,E155 hücreleri ya da

=D149:E153 ve =D155:E156 kısımlarına belirtmiş olduğunuz komut sonrası macro ya da komut ile CTRL+SHIFT+ENTER ile dizi formülüne otomatik onay verdirmek. Dosya özel karış bir dosya olduğundan atamadım ama dosya diyorsanız boş bir dosya ayarlayım.
 
Private Sub CommandButton1_Click()
Dim sifre
sifre = InputBox("Lütfen Şifre Giriniz")
If sifre = "123" Then
Range("E5:H22").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF5:AH22").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH7").Select
ActiveWindow.SmallScroll Down:=24
Range("E30:H57").Select
ActiveWindow.SmallScroll Down:=-9
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF30:AH57").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=39
Range("E65:H93").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF65:AH93").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH71").Select
ActiveWindow.SmallScroll Down:=-135
Range("Q1:S1").Select
Else
MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
End If
End Sub




Bunu nasıl kısa hale getirebilirim hocam? Diğerine göre uyarladım sanırım
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

kısımlarında hata veriyor..
 
Merhaba.
Aşağıdaki gibi olabilir.

Kod:
Private Sub CommandButton1_Click()
    Dim sifre
    Dim Alan As Range
    Dim Bak As Range
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then
    Set Alan = Range("E5:H22,AF5:AH22,E30:H57,AF30:AH57,E65:H93,AF65:AH93")
        For Each Bak In Alan
            Bak = Bak.Text
        Next
    Else
    MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
End Sub
 
Merhaba.
Aşağıdaki gibi olabilir.

Kod:
Private Sub CommandButton1_Click()
    Dim sifre
    Dim Alan As Range
    Dim Bak As Range
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then
    Set Alan = Range("E5:H22,AF5:AH22,E30:H57,AF30:AH57,E65:H93,AF65:AH93")
        For Each Bak In Alan
            Bak = Bak.Text
        Next
    Else
    MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
End Sub


Olmadı hocam hücreleri alt üst etti...
 
Nasıl alt üst etti?
Yazdığım kod sadece hücrelerde bulunan formülü silip yerine formül sonucunu yazıyor.
 
Örnek dosyanızı ekler misiniz?

Hocam dosya çok büyük ve karışık. Örnek olması için size bir dosya gönderdim sarı ile boyalı alana istediğimi yaptırabilirseniz ben ona göre formülü uyarlarım hocam.

Teşekkürler.
 

Ekli dosyalar

Örnek dosyada kodlar tam istediğiniz gibi çalışıyor.

Bir de aşağıdaki kodları deneyin.

Kod:
Private Sub CommandButton1_Click()
    Dim sifre
    Dim Alan As Range
    Dim Bak As Range
    Application.EnableEvents = False
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then

    Set Alan = Range("A5:N22")
    
        For Each Bak In Alan
            Bak = Bak.Text
        Next
    Else
    MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
    Application.EnableEvents = True
End Sub
 
Örnek dosyada kodlar tam istediğiniz gibi çalışıyor.

Bir de aşağıdaki kodları deneyin.

Kod:
Private Sub CommandButton1_Click()
    Dim sifre
    Dim Alan As Range
    Dim Bak As Range
    Application.EnableEvents = False
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then

    Set Alan = Range("A5:N22")
   
        For Each Bak In Alan
            Bak = Bak.Text
        Next
    Else
    MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
    Application.EnableEvents = True
End Sub




Sorun 1502,2500,4500 gibi değerleri 1,502 , 2,500 , 4,500 şekline dönüştürmesi hocam. Bu sebepten dolayı da yuvarlama yaptığı için 2,3,4 şeklinde yapıyor. Dosyam ekte farklı bir örnek olarak gösterdim.
 

Ekli dosyalar

Koddaki text den kaynaklanıyor value yapmamız gerekiyor.

Kod:
Private Sub CommandButton1_Click()
    Dim sifre
    Dim Alan As Range
    Dim Bak As Range
    Application.EnableEvents = False
    sifre = InputBox("Lütfen Şifre Giriniz")
    If sifre = "123" Then

    Set Alan = Range("A5:N22")
    
        For Each Bak In Alan
            Bak = Bak.value
        Next
    Else
    MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
    End If
    Application.EnableEvents = True
End Sub
 
Private Sub CommandButton1_Click()
Dim sifre
Dim Alan As Range
Dim Bak As Range
Application.EnableEvents = False
sifre = InputBox("Lütfen Şifre Giriniz")
If sifre = "123" Then
Set Alan = Range("E5:H22,AF5:AH22,E30:H57,AF30:AH57,E65:H93,AF65:AH93")
For Each Bak In Alan
Bak = Bak.Value
Next
Else
MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
End If
End Sub

Şimdi oldu güzel hocam ancak nedense diğer komutuma göre çok yavaş işlem yaptı. Neyse artık idare edecez. Ama temizleme de bu şekilde kullanınca çok hızlı yapmıştı diğerine göre..Teşekkürler.
 
End Sub satırından önce Application.EnableEvents = True satırını eklemelisiniz.

Aşağıdaki gibi olmalı.
Private Sub CommandButton1_Click()
Dim sifre
Dim Alan As Range
Dim Bak As Range
Application.EnableEvents = False
sifre = InputBox("Lütfen Şifre Giriniz")
If sifre = "123" Then
Set Alan = Range("E5:H22,AF5:AH22,E30:H57,AF30:AH57,E65:H93,AF65:AH93")
For Each Bak In Alan
Bak = Bak.Value
Next
Else
MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
End If
Application.EnableEvents = True
End Sub
 
End Sub satırından önce Application.EnableEvents = True satırını eklemelisiniz.

Aşağıdaki gibi olmalı.
Private Sub CommandButton1_Click()
Dim sifre
Dim Alan As Range
Dim Bak As Range
Application.EnableEvents = False
sifre = InputBox("Lütfen Şifre Giriniz")
If sifre = "123" Then
Set Alan = Range("E5:H22,AF5:AH22,E30:H57,AF30:AH57,E65:H93,AF65:AH93")
For Each Bak In Alan
Bak = Bak.Value
Next
Else
MsgBox "Hatalı Şifre İzinsiz İşleme Müsaade Edilemez", vbCritical, "INCSOFT"
End If
Application.EnableEvents = True
End Sub

yine çok aşırı yavaş hocam.
 
Geri
Üst