toplu makro durdurma

[igultekin2000]

iyi günler;
çeşitli makroları , makro ile birleştirerek ilgili sayfadaki cariler bitene kadar işlem yapıyor, başka işlemlerde her firma ile ilgili işlem bittikten sonra makronun durup, onay butonu ile kaldığı yerden tekrar devam etmesini sağlamak istiyorum. kullandığım makroya ne gibi ilave yapılabilir. dosya boyutu 6 mb olduğu için yükleyemedim.

Sub Tum()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Firma As String
Dim i, say As Long

Set s1 = ThisWorkbook.Worksheets("CARI_HRK")
Set s2 = ThisWorkbook.Worksheets("listele")

say = s2.Cells(s2.Rows.Count, "b").End(3).Row

For i = 2 To say
 Firma = s2.Cells(i, "F").Value
If Firma <> "" Then
 
    s1.Cells(1, "b").Value = Firma
    Call aktarr
    Call SATIR_SIL
    Call detay_musteri
    Call tek_sayi_cevir
    Call ODENMEYENLER
    Call liste_biriktir

 
End If
Next i


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[EmrExcel16]

Merhaba ,

Tam olarak isteğinizi karşılar mı bilemiyorum ama kod arasında mesaj verilmesi gereken yerlere aşağıdaki kodu ekleyip deneyebilirsiniz. Sadece if olan satırı eklemeniz yeterli olacaktır.

Sub Test()

    If MsgBox("Merhaba makroya devam etmek istiyormusun ?", vbQuestion + vbYesNo + vbDefaultButton2, "Baslik") = vbNo Then Exit Sub
    MsgBox "Makroya devam ediyorum"

End Sub

 

[kulomer46]

Merhaba

Bende yukardaki #1 numaralı mesajdaki kod bloğuna, #2 numaralı mesajdaki kod bloğunun eklenmesi gereken yer hakkında yorum ekliyorum.

Kolay Gelsin..

'#1 Numaralı Mesajdaki Kod Bloğu
Sub Tum()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Firma As String
Dim i, say As Long

Set s1 = ThisWorkbook.Worksheets("CARI_HRK")
Set s2 = ThisWorkbook.Worksheets("listele")

say = s2.Cells(s2.Rows.Count, "b").End(3).Row

For i = 2 To say
Firma = s2.Cells(i, "F").Value
If Firma <> "" Then

s1.Cells(1, "b").Value = Firma
Call aktarr
Call SATIR_SIL
Call detay_musteri
Call tek_sayi_cevir
Call ODENMEYENLER
Call liste_biriktir


'''#2 Numaralı Mesajdaki Kod Bloğunu eklenmesi gereken yer

If MsgBox("Merhaba makroya devam etmek istiyormusun ?", vbQuestion + vbYesNo + vbDefaultButton2, "Baslik") = vbNo Then Exit Sub
MsgBox "Makroya devam ediyorum"

End If
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
'#1 Numaralı Mesajdaki Kod Bloğu Sonu

 

[igultekin2000]

Merhaba ,

Tam olarak isteğinizi karşılar mı bilemiyorum ama kod arasında mesaj verilmesi gereken yerlere aşağıdaki kodu ekleyip deneyebilirsiniz. Sadece if olan satırı eklemeniz yeterli olacaktır.

Sub Test()

    If MsgBox("Merhaba makroya devam etmek istiyormusun ?", vbQuestion + vbYesNo + vbDefaultButton2, "Baslik") = vbNo Then Exit Sub
    MsgBox "Makroya devam ediyorum"

End Sub

firma işlemi bitince işlemi duruduryor, ancak o durumda firma üzerinde düzenleme yapmama izin vermiyor, durunca ekran üzerindeki caride düzeltme yapamam gerek durumlar oluyor, o yüzden durdurmak istiyorum.

 

[igultekin2000]

Merhaba

Bende yukardaki #1 numaralı mesajdaki kod bloğuna, #2 numaralı mesajdaki kod bloğunun eklenmesi gereken yer hakkında yorum ekliyorum.

Kolay Gelsin..

'#1 Numaralı Mesajdaki Kod Bloğu
Sub Tum()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Firma As String
Dim i, say As Long

Set s1 = ThisWorkbook.Worksheets("CARI_HRK")
Set s2 = ThisWorkbook.Worksheets("listele")

say = s2.Cells(s2.Rows.Count, "b").End(3).Row

For i = 2 To say
Firma = s2.Cells(i, "F").Value
If Firma <> "" Then

s1.Cells(1, "b").Value = Firma
Call aktarr
Call SATIR_SIL
Call detay_musteri
Call tek_sayi_cevir
Call ODENMEYENLER
Call liste_biriktir


'''#2 Numaralı Mesajdaki Kod Bloğunu eklenmesi gereken yer

If MsgBox("Merhaba makroya devam etmek istiyormusun ?", vbQuestion + vbYesNo + vbDefaultButton2, "Baslik") = vbNo Then Exit Sub
MsgBox "Makroya devam ediyorum"

End If
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
'#1 Numaralı Mesajdaki Kod Bloğu Sonu

Makro çalışıyor, firma bitince işlemi durduruyor, ancak makro durduğunda ondaki firmayla ilgili çalışma yapacağımdan yazıp silmeme izin vermesi gerekiyor

 

[EmrExcel16]

firma işlemi bitince işlemi duruduryor, ancak o durumda firma üzerinde düzenleme yapmama izin vermiyor, durunca ekran üzerindeki caride düzeltme yapamam gerek durumlar oluyor, o yüzden durdurmak istiyorum.

Anladım , baştanda söyledim tam olarak isteğinizi karşılar mi bilemiyorum diye , ama siz makro çalışırken dursun sayfada işlemlerimi yapayım sonra devam etsin diyorsunuz , bu mümkün mü bilmiyorum (bildiğim mümkün değil) , ama buna neden ihtiyaç duyuyorsunuz herşeyi makroya yaptirmaya çalışsak olmaz mı ,size iş birakmayalim

 

[igultekin2000]

haklısınız ama bazı işlemler de bu kodları kullanmak hem zaman kaybını önlüyor, hem de işlemler yapılırken çay içip o güzelliği seyretmek harika oluyor. Genede bir soru sorayım istedim; sorunu makro kaydetle yaptığım

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("L4").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L4").Select
    Selection.Delete Shift:=xlUp
    Range("I3").Select
End Su

kod işimi halletti, ancak bu L4 hücresinden aşağıda giden değerleri kopyalayıp B hücresine yapıştırıyor, ve hücreleri yukarı sürükle ile o hücre silinip alttan gelen onun yerine geçiyor, buton atayıp işlem bitince butonla devam ettiriyorum. sormak istediğim yukarı sürükle değilde imlecin her seferinde aşağı kayıp oradaki değeri B2 ' ke kopyala yapıştırması olabilir mi? bu işlemde sorun değilde yapacağım başka işlemde bayağı işime yarayacaktı. Teşekkürler

 

[EmrExcel16]

hem de işlemler yapılırken çay içip o güzelliği seyretmek harika oluyor

Hahahahaha bu güzeldi

Evet kod L4 ü kopyaliyor sonrada siliyor değerler yukari kayıyor , ama siz silmesin butona her bastığınizda bir alttakini seçsin istiyorsunuz. Doğru mu anladım?

 

[EmrExcel16]

Eğer öyle ise şu şekilde olabilir.
Not = Telefondan yazdım , test edemedim .

sub Test()
    if ActiveCell.Column = 12 and ActiveCell.Row > 3 Then
        [B2].value = activecell.value
        ActiveCell.Offset(1,0).Select
    Else
        Msgbox "imlec uygun alanda degil"
    End if
End sub

 

[igultekin2000]

Eğer öyle ise şu şekilde olabilir.
Not = Telefondan yazdım , test edemedim .

sub Test()
    if ActiveCell.Column = 12 and ActiveCell.Row > 3 Then
        [B2].value = activecell.value
        ActiveCell.Offset(1,0).Select
    Else
        Msgbox "imlec uygun alanda degil"
    End if
End sub

Teşekkür ederim, sorunsuz çalıştı, istediğim gibi oldu, iyi çalışmalar.

 

[EmrExcel16]

Teşekkür ederim, sorunsuz çalıştı, istediğim gibi oldu, iyi çalışmalar.

Rica ederim , istediğiniz gibi olmasina sevindim , kolay gelsin.