Döngüye Giren Formüller Hakkında

YUSUF44 · 17 Mart 2020

Makro aşağıdaki gibi daha doğru oldu ama maalesef belirttiğiniz gibi 4. satırdaki değişiklikleri dikkate almıyor. Daha doğrusu 30. satırı kopyalayıp ilgili yere yapıştırma döngüsünü işletmiyor. Nedenini çözemedim. Başka arkadaşlar umarım çözüm bulurlar:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C5:C15]) Is Nothing Then GoTo 10
If Selection.Count > 1 Then Exit Sub
sat = Target.Row
sut = (sat - 1) * 8
If Target = "" Then
    Range("D" & sat & ":I" & sat).ClearContents
    Exit Sub
End If
a = 0

If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
    And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
    Exit Sub
Else
    Application.ScreenUpdating = False
        Do
            Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
            a = a + 1
        Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
            And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
    Application.ScreenUpdating = True
End If

10:
If Intersect(Target, [AL4:DN4]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sut = Target.Column - 6
sat = sut / 8 + 1
'[D1] = sat
'[E1] = sut

'Cells(1, sut) = Target.Column + 2 Mod 8
If Target.Column + 2 Mod 8 <> 0 Then Exit Sub

a = 0

If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
    And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
    Exit Sub
Else
    Application.ScreenUpdating = False
        Do
            Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
            a = a + 1
        Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
            And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
    Application.ScreenUpdating = True
End If

If a > 10 Then MsgBox "10 denemede sonuca ulaşılamadğından işlem sonlandırıldı!"

End Sub

oguzhan5334 · 17 Mart 2020

Yardımcı olabilecek arkadaşlar mesaj atabilir mi?

YUSUF44 · 18 Mart 2020

Aşağıdaki gibi düzeldi. Nedense koddaki mod alma işlemi düzgün çalışmıyordu. Ben de 1. satırda bir hücreye formülle mod alma işlemi yaptırdım:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C5:C15]) Is Nothing Then GoTo 10
If Selection.Count > 1 Then Exit Sub
sat = Target.Row
sut = (sat - 1) * 8
If Target = "" Then
    Range("D" & sat & ":I" & sat).ClearContents
    Exit Sub
End If
a = 0

If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
    And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
    Exit Sub
Else
    Application.ScreenUpdating = False
        Do
            Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
            a = a + 1
        Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
            And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
    Application.ScreenUpdating = True
End If

10:
If Intersect(Target, [AL4:DN4]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sut = Target.Column - 6
sat = (Target.Column + 2) / 8

'[D1] = sat Makronun nerde hata yaptığını bulmak için eklemiştim
'[E1] = sut Makronun nerde hata yaptığını bulmak için eklemiştim

Cells(1, sut).FormulaR1C1 = "=MOD(COLUMN(R[3]C[6])+2,8)" 'Bu kısım makronun mod alma işlemini düzgün yapması için
If Cells(1, sut) <> 0 Then Exit Sub

a = 0

If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
    And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
    Exit Sub
Else
        Do
            Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
            a = a + 1
        Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
            And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
End If

If a > 10 Then MsgBox "10 denemede sonuca ulaşılamadğından işlem sonlandırıldı!"

End Sub

oguzhan5334 · 18 Mart 2020

Eline sağlık üstadım. Makro çalıştırma için birkaç soru olacak size;

1. Aynı sayfa içinde birden çok makroyu çalıştıramıyoruz kodların değişmesi lazım demiştiniz . Şöyle bir şey yapsam bu kod çalışır mı?

Biz bu kodu 11 satır için yazdırdık ya , benim bu 11 satırdan hariç aynı sayfada buna benzer hesaplarım var ve işlem sırası tamamen aynı. ( satır numaraları 100 lerde aralarda başka işlemlerim var,sıralı gitmiyor yani.)

Ben bu işlemi yaptıracağım hücreleri başka sayfaya = ile çeksem ve o sayfada makroyu kod görüntüleye koysam. Daha sonra ana sayfada verileri değiştirsem makro o sayfaya gitmeden çalışır mı ?

YUSUF44 · 18 Mart 2020

Kodda C5:C15 aralığı ve AL4

N4 aralığı için iki ayrı işlem yaptırıyoruz. İsterseniz M55:N102 ya da AK130:BB150 gibi değişik yerler için de değişik düzenlemeler yapılabilir. Bunun için hangi şartlarda hangi hücrelerde ne yapılacağını açıkça belirtin.

oguzhan5334 · 18 Mart 2020

Ben sizi yormak istemiyorum şöyle bir örnek ile anlatayım.
1. nolu sayfamda bu makro olsun ve C5:C15 için çalışıyor. Benim C15 ten sonra C40 arasında metin yazı vs var.
örnek olarak C41:C45 arasında C5:C15 'te yaptığımız işlemi yaptırmam gerekecek. Ama makro bu hücrelere uygun değil ve makrom çalışmayacak.

Bundan sonrası için;
C41:C45 teki verileri = ile "deneme" adlı sayfaya çektiğimi ve deneme adlı sayfada C5:C15 'e yazdırayım. Yukarıdaki makroyuda deneme adlı sayfamın kod kısmına ekleyeyim.

1. sayfaya döndüğümde ben C41:C45 e veri girdiğimde deneme sayfamdaki makro çalışır mı? Şayet çalışırsa zaten verileri = ile formüllediğim için 1. sayfaya çekecektir. Bunu anlatmak istedim.

YUSUF44 · 18 Mart 2020

Çalışmaz. Çalışması için makroda C41:C45 arası için de ayrı düzenleme yapılmalıdır.

oguzhan5334 · 18 Mart 2020

YUSUF44' Alıntı:
Çalışmaz. Çalışması için makroda C41:C45 arası için de ayrı düzenleme yapılmalıdır.

Anladım , şirkettekilerle görüşeyim profesyonel destek aldıralım yoksa buradan sizi de yorarız anlatmak istediklerim bu kadarla sınırlı değil.Çok daha fazlası var dosya paylaşamadığım için yüz yüze görüşmeden de çözülmez.

Emekleriniz için teşekkür ederim.

oguzhan5334 · 20 Mart 2020

@YUSUF44 Hocam yavaştan makro öğrenmeye başlıyorumda aklıma söyle bir şey geldi. Bizim makro sayfamız Change durumunda herhangi bir değişiklik olunca makro çalışıyor otomatik. Bunun yerine ben her satırın kenarına buton koyarak makro atasam ve tıkladığımda o satır için makro çalışsa olur mu ?

YUSUF44 · 20 Mart 2020

Olur ama kullanışlı olmaz. Her satır için ayrı düğme yerine tek makro ve tek düğmeyle seçili satırda işlem yaptırmak daha mantıklı ve pratik olur.

oguzhan5334 · 20 Mart 2020

Nasıl yapılacağına dair adım sırasını belirtirseniz kodları vs ben arayıp bulup, kendim yazmayı deneyeyim.

YUSUF44 · 24 Mart 2020

Aşağıdaki makro seçili olan hücrenin yerine göre işlem yapar. Ancak bu kodu mevcut dosyanıza göre düzenledim. Eğer daha önce bahsettiğiniz gibi aşağıya doğru başka bloklar hazırlayacaksanız hatalı sonuçlar verebilir. Dosyanızın o haliyle de kullanmak istiyorsanız o halini de paylaşmanız gerekir ki düzenleme yapabilelim:

PHP:

Sub denemeler()
If ActiveCell.Column = 3 Then
    sat = ActiveCell.Row
    sut = (sat - 1) * 8
ElseIf ActiveCell.Column >= 31 Then
    yer = ActiveCell.Column Mod 8
    If yer = 7 Then
        sut = ActiveCell.Column + 1
    Else
        sut = ActiveCell.Column - yer
    End If
    sat = sut / 8 + 1
Else
    MsgBox "Lütfen işlem yapılabilecek alanda bir hücre seçiniz!"
    Exit Sub
End If

a = 0
If ActiveCell.Column = 3 Then
    If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
        And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
        Exit Sub
    Else
        Application.ScreenUpdating = False
            Do
                Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
                a = a + 1
            Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
                And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
        Application.ScreenUpdating = True
    End If

ElseIf ActiveCell.Column >= 31 Then

    If Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
        And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Then
        Exit Sub
    Else
        Do
            Range(Cells(30, sut), Cells(30, sut + 5)).Copy: Cells(sat, "D").PasteSpecial Paste:=xlValues
            a = a + 1
        Loop Until Cells(sat, "D") = Cells(30, sut) And Cells(sat, "E") = Cells(30, sut + 1) And Cells(sat, "F") = Cells(30, sut + 2) _
            And Cells(sat, "G") = Cells(30, sut + 3) And Cells(sat, "H") = Cells(30, sut + 4) And Cells(sat, "I") = Cells(30, sut + 5) Or a > 10
    End If

End If

If a > 10 Then MsgBox "10 denemede sonuca ulaşılamadğından işlem sonlandırıldı!"

End Sub

oguzhan5334 · 25 Mart 2020

@YUSUF44 Hocam teşekkür ettim yaptığınızda güzel oldu. Ben bahsettiğim gibi aşağıdaki her satıra şöyle makro yaptım. Bunuda butona bağladım, butona bastığımda makro çalışıyor.

Kod:

Sub Ray_4()
    Range("BG30:BL30").Select
    Selection.Copy
    Range("G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BG30:BL30").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("BG30:BL30").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Döngüye Giren Formüller Hakkında

YUSUF44

Destek Ekibi

oguzhan5334

YUSUF44

Destek Ekibi

oguzhan5334

YUSUF44

Destek Ekibi

oguzhan5334

YUSUF44

Destek Ekibi

oguzhan5334

oguzhan5334

YUSUF44

Destek Ekibi

oguzhan5334

YUSUF44

Destek Ekibi

oguzhan5334