Belirtilen şartı karşılamıyorsa uyarı verdirmek

[EKREM1661]

Değerli Arkadaşlar..! Bir kod'un başına bir uyarı koymak istiyorum..
(Seçili satır için uygulanan bir kod.. Kalabalık yapmasın diye eklemedim.)

Seçili aktif satırın sol hizasındaki (karşılığındaki) A sütununda sayı varsa (veya dolu ise) kodu çalıştırsın, değilse çalıştırmasın, uyarı versin)
Yani kodu çalıştırması için, diyelimki 10 nolu satır seçili ise, A10 da sayı (veya dolu) olması lazım..

 

[Ömer BARAN]

Merhaba. Aşağıdaki şekilde olabilir.

If Range(ActiveCell[B][COLOR="Red"].Row[/COLOR][/B],1)="" Then
MsgBox "UYARI METNİ"
End If
[COLOR="Red"]çalıştıracağınız kodlar[/COLOR]

veya

If Range(ActiveCell[B][COLOR="Red"].Row[/COLOR][/B],1)<>"" Then
[COLOR="Red"]çalıştıracağınız kodlar[/COLOR]
Else
MsgBox "UYARI METNİ"
End If

 

[EKREM1661]

Ömer hocam..! Bende olmadı, 1004 hatası veriyor, görmeniz için kodları eklemem lazım..

Private Sub CommandButton4_Click()

[COLOR="Red"]If Range(ActiveCell, 1) = "" Then
MsgBox "UYARI METNİ"
End If[/COLOR]

Uyarı = MsgBox("Seçili satır, alt grubu ile birlikte 5 satır arşiv sayfasına taşınacak..!" & vbCrLf & " " & vbCrLf & "Devam Edilsin mi.?", vbSystemModal + vbInformation + vbYesNo)
If Uyarı = 6 Then
Else: Exit Sub
End If

Dim sat1 As Long, sat2 As Long, sirano As Long
Dim sh As Worksheet
Sheets("MesireVeritabanı").Select
Set sh = Sheets("m-arşivi")
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
sirano = sat2 - 4
sat1 = ActiveCell.Row
Range("A" & sat1 & ":AAA" & sat1 + 4).Copy sh.Range("A" & sat2)
sh.Range("A" & sat2).Value = sirano
Rows(sat1 & ":" & sat1 + 4).Delete
MsgBox "Aktarım işlemi gerçekleşti.."

End Sub

 

[Ömer BARAN]

Gönderdiğim kodda eksiklik var, ActiveCell yerine ActiveCell.Row olarak değiştirin, atlamış olmalıyım.
Yukarıdaki cevabı güncelledim.

 

[EKREM1661]

Ömer bey, düzelmedi aynı hatayı verdi.. (method "range of object" worksheed failed)

 

[Ömer BARAN]

Keşke belgenizin bir parçasını ekleseydiniz.
Kod örneğin Worksheet Selection Change ile mi tetikleniyor, öyleyse hangi sayfanın Change olayına bağlıdır filan bilemiyorum.

Hangi sayfanın A sütunu kontrol ediliyorsa o sayfanın adını aşağıdaki gibi eklemek lazım sanırım.
If Sheets("m-arşivi").Range(ActiveCell.Row, 1) = "" Then
Bu arada bu If .. End If kısmını eklemeden önce kodda bir sorun yoktu umarım.
Çünkü kod'u bir belgeye uygulayarak denemiş değilim.

 

[EKREM1661]

Ömer bey, yeni bir dosya üzerinde uygulamasını yaptım, durum değişmedi..

 

[Ömer BARAN]

Yanlış anlamadıysam; kodları aşağıdaki ile değiştiriniz.

Private Sub CommandButton1_Click()
If Cells(ActiveCell.Row, 1) <> "" Then

Uyarı = MsgBox("Seçili satır, alt grubu ile birlikte 5 satır arşiv sayfasına taşınacak..!" & vbCrLf & " " & vbCrLf & "Devam Edilsin mi.?", vbSystemModal + vbInformation + vbYesNo, "DEĞİŞİKLİK UYARISI")
If Uyarı = 6 Then
Else: Exit Sub
End If

Dim sat1 As Long, sat2 As Long, sirano As Long
Dim sh As Worksheet
Sheets("MesireVeritabanı").Select
Set sh = Sheets("m-arşivi")
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
sirano = sat2 - 4
sat1 = ActiveCell.Row
Range("A" & sat1 & ":AAA" & sat1 + 4).Copy sh.Range("A" & sat2 + 4)
sh.Range("A" & sat2 + 4).Value = sirano
Rows(sat1 & ":" & sat1 + 4).Delete
MsgBox "Aktarım işlemi gerçekleşti.."

Else
MsgBox ("A SÜTUNU BOŞ")
End If

End Sub

 

[EKREM1661]

Ömer bey..! Ziyadesiyle teşekkürler..Elinize sağlık.. Sayende bu iştende kurtulduk.. Sadece arşiv sayfasında, aktarılan satır başındaki sıra numarasını düzeltmiyor, olduğu gibi aktarıyor; ki o da hiç önemli değil elle gireriz, küçük işlere kafa yormaya gerek yok.. Bu kadar yeter.. ALLAH razı olsun, iyi akşamlar dilerim..

 

[Ömer BARAN]

Ben verilere, sizin gönderdiğiniz aktarma kodlarına hiç bakmadım doğrusu.
Sıra numarası olayını da; koddaki aktarma işleminden sonra (ilavenin kodun neresine yapılacağını, verinin alndığı sayfada A sütununun dolu olduğu bir hücreyi seçip, belge ve kod ekranını aynı anda görecek şekilde ekranda yerleştirdikten sonra, kod ekranına geçip command button1 click makrosunun bir satırına tıkladıktan sonra, klavyeden F8 tuşuna tekrar tekrar basarak -her basışınızda koddaki bir satır sarıya boyanır, sarıya boyanan satırın bir üstündeki satır en son F8 tuşuna bastığınızda işlemi yapan satırdır- oradan takip edersiniz sıra numarası için ilave kod satırları aktarma işlemi kod'un hangi satırı sarı iken gerçekleşiyorsa oraya yazılacak demektir.
Bilgisayar başına geçtiğimde ilave işlemini yaparım, şu an cep telefonundan yazıyorum.
Kolay gelsin.

 

[Ömer BARAN]

Tekrar merhaba.

Sıra numarası da eklenmiş olarak, levcut kod'u aşağıdaki kod le değştererek, test ediniz.

Private Sub CommandButton1_Click()
Dim sat1 As Long, sat2 As Long, sirano As Long
Dim ma As Worksheet: Set ma = Sheets("m-arşivi")
Dim mv As Worksheet: Set mv = Sheets("MesireVeritabanı")
mv.Activate
sat2 = ma.Cells(Rows.Count, "A").End(xlUp).Row + 1
sat1 = ActiveCell.Row
sonmv = (ma.[A65536].End(3).Row + 5) / 5
    If Cells(ActiveCell.Row, 1) <> "" Then
Uyarı = MsgBox("Seçili satır, alt grubu ile birlikte 5 satır arşiv sayfasına taşınacak..!" & vbCrLf & " " & vbCrLf & "Devam Edilsin mi.?", vbSystemModal + vbInformation + vbYesNo, "DEĞİŞİKLİK UYARISI")
    If Uyarı = 6 Then
        Else: Exit Sub
    End If
Range("A" & sat1 & ":AAA" & sat1 + 4).Copy ma.Range("A" & sat2 + 4)
ma.Range("A" & sat2 + 4).Value = sonmv
Rows(sat1 & ":" & sat1 + 4).Delete
MsgBox "Aktarım işlemi gerçekleşti.."
    Else
        MsgBox ("A SÜTUNU BOŞ")
    End If
End Sub

 

[EKREM1661]

Ömer bey, gerçekten harika olmuş, tekrar tekrar teşekkürler ve tüm yaşamınızda başarılar dilerim..