On Error GoTo - tekrarlamak

[fredycrouger]

Merhaba,

asagidaki ornekteki kod Error1 de calisiyor fakat sonrakinde Run-time error '9' Subscript out of range hatasi veriyor. Exit sub yapmadan bu kodu calisir hale getirmenin bir yolu varmi acaba ?

Simdiden yardimlariniz icin cok tesekkurler.

Sub test()
'
' test Macro
'

'
On Error GoTo Error1

Error durumunda atlamasini istedigim kod


Error1:
        
    Else
    End If

On Error GoTo Error2

Error durumunda atlamasini istedigim ikinci kod


Error2:
      
    Else
    End If


On Error GoTo Error3

Error durumunda atlamasini istedigim ucuncu kod

Error3:

End If
End Sub

 

[YUSUF44]

Kod nerede? Hepsi bu mu?

 

[fredycrouger]

Sn. @YUSUF44 Kodun tamami asagidaki gibi:

Sub test()
'
' test Macro
'

'
On Error GoTo eb

Sheets("SRKO").Select
If IsEmpty(Range("A2")) = False Then

    Dim str As String
    Dim n As Integer

    str = Cells(n + 1, 4).Value
    
    Do Until Len(str) = 0

    n = n + 1
    str = Cells(n + 1, 4).Value

    Cells(n + 1, 4).Select
    str = ActiveCell.Value

    Cells(n + 1, 4).Value = Left(str, 11) & "-" & Right(str, 1)
    

    Loop
    Selection.EntireRow.delete

 
    Else
    End If
    
    If IsEmpty(Range("A2")) = True Then
    
Application.DisplayAlerts = False
    Sheets("SRKO").Select
    ActiveWindow.SelectedSheets.delete
    Application.DisplayAlerts = True
    
eb:
    
    Else
    End If
    
On Error GoTo ec

Sheets("ZUS").Select
If IsEmpty(Range("A2")) = False Then


    Dim m As Integer

    str = Cells(m + 2, 4).Value
    
    Do Until Len(str) = 0

    m = m + 1
    str = Cells(m + 1, 4).Value

    Cells(m + 1, 4).Select
    str = ActiveCell.Value

    Cells(m + 1, 4).Value = Left(str, 11) & "-" & Right(str, 1)
    
    Loop
    Selection.EntireRow.delete

    
    Else
    End If
    
    If IsEmpty(Range("A2")) = True Then
    
Application.DisplayAlerts = False
    Sheets("ZUS").Select
    ActiveWindow.SelectedSheets.delete
    Application.DisplayAlerts = True
    
    
ec:
  
    Else
    End If

On Error GoTo ed

Sheets("BGO").Select
If IsEmpty(Range("A2")) = False Then


    Dim k As Integer

    str = Cells(k + 2, 4).Value
    
    Do Until Len(str) = 0

    k = k + 1
    str = Cells(k + 1, 4).Value

    Cells(k + 1, 4).Select
    str = ActiveCell.Value

    Cells(k + 1, 4).Value = Left(str, 11) & "-" & Right(str, 1)
    
    Loop
    Selection.EntireRow.delete

    
    Else
    End If
    
    If IsEmpty(Range("A2")) = True Then
    
Application.DisplayAlerts = False
    Sheets("BGO").Select
    ActiveWindow.SelectedSheets.delete
    Application.DisplayAlerts = True

ed:


End If
End Sub

 

[Korhan Ayhan]

Dosyanızı ekleyip yapmak istediğiniz işlemi açıklarsanız daha farklı önerilerde gelebilir.

 

[fredycrouger]

Dosyanızı ekleyip yapmak istediğiniz işlemi açıklarsanız daha farklı önerilerde gelebilir.

@Korhan Ayhan Bey ilginiz icin cok tesekkurler.

Yapmak istedigim olay kisaca su:

Gunluk olarak bana bir tablo geliyor ve bu tablodaki 3 tane sekme degisken (SRKO,ZUS,BGO). Yani bir gun olup diger gun olmayabiliyor. Benimde amacim eger sekme var ise kodu uygulamasi, yok ise sonraki iki sekme icinde ayni islemi tekrarlamasi.

Bu sinama olmaz ise sekmelerden herhangi biri eksik olursa dogal olarak hata veriyor.

 

[fredycrouger]

Dun destek ekibinden Sn. @dalgalikur asagidaki kodu verdi sagolsun, kod tek basina calisiyor fakat elimdeki kodun butunune ekledigim zaman en alttaki Next ten sonra basa donup koda devam etmiyor ve sonucta kod calismadan tamamlaniyor.

Bu sebeple bende kendimdeki kodu calisir hale getirmeye calisiyorum. Acikcasi "On Error GoTo" ilk seferden sonra calismayi durdurmasa hic bir sorun kalmayacakti.

Option Explicit

Sub deletetabs()
    Dim Sayfalar As Worksheet
    Dim Bak As Range
    For Each Sayfalar In ThisWorkbook.Worksheets
        If Sayfalar.Name = "SRKO" Or Sayfalar.Name = "ZUS" Or Sayfalar.Name = "BGO" Then
            With Sayfalar
                If IsEmpty(.Range("A2")) = False Then
                    For Each Bak In .Range("D2:D" & .Cells(Rows.Count, "D").End(3).Row)
                        Bak = Left(Bak, 11) & "-" & Right(Bak, 1)
                    Next
                Else
                    Application.DisplayAlerts = False
                    Sayfalar.delete
                    Application.DisplayAlerts = True
                End If
            End With
        End If
    Next
End Sub

 

[Muzaffer Ali]

Eğer sayfa isimleri "SRKO", "ZUS" "BGO" dan biriyse kod mutlaka çalışır.
Eğer başka sayfa eklemek isterseniz.
If Sayfalar.Name = "SRKO" Or Sayfalar.Name = "ZUS" Or Sayfalar.Name = "BGO" Then
satırına "Then" den önce Or Sayfalar.Name = "SAYFAADI" Eklemeniz yeterli

 

[fredycrouger]

Eğer sayfa isimleri "SRKO", "ZUS" "BGO" dan biriyse kod mutlaka çalışır.
Eğer başka sayfa eklemek isterseniz.
If Sayfalar.Name = "SRKO" Or Sayfalar.Name = "ZUS" Or Sayfalar.Name = "BGO" Then
satırına "Then" den önce Or Sayfalar.Name = "SAYFAADI" Eklemeniz yeterli

Sn. @dalgalikur vermis oldugunuz kodu bir sekilde bendeki kod ile birlestirip calistirdim fakat simdide sorunum su ki ben bu kodu acip baska bir tabloda calistiriyorum. Yani her gun bana gelen tablonun icine kopyalamak yerine icinde kod bulunan excel dosyasini actiktan sonra bana gelen rapordan kodu bulup calistiriyorum. Ne yazik ki bu sekilde kodu calistirmayi basaramadim.

 

[Korhan Ayhan]

Çözüm için örnek dosyalarınızı ekleyiniz. Ayrıca işlemi nasıl yaptığınızı açıklayınız.

 

[fredycrouger]

Çözüm için örnek dosyalarınızı ekleyiniz. Ayrıca işlemi nasıl yaptığınızı açıklayınız.

@Korhan Ayhan Bey tablo linki asagidadir, bu kodu Visual basic icerisinden insert module seklinde eklersem calisiyor fakat baska bir dosyadan calistirdigimda (1 tane excel dosyasini sadece formulleri calistirmak icin kullaniyorum) yine kodun icinde bulundugu dosyada islem yapiyor. Oysa kodu calistirdigim tabloda islem yapmasi gerekiyor.

Link: https://files.fm/u/mba3frgp