A sütunu X ise diğer makro çalışsın

[sirkülasyon]

1-) Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [L3:L100]) Is Nothing Then

If Target.Value = "Firma" Then Target.Offset(0, 5).Value = Target.Offset(0, 1).Value * Target.Offset(0, 2).Value * 0.08
If Target.Value = "Gerçek Usul" Then Target.Offset(0, 5).Value = Target.Offset(0, 1).Value * Target.Offset(0, 2).Value * 0.08
If Target.Value = "Basit Usul" Then Target.Offset(0, 5).Value = 0#
Target.Offset(0, 3).Value = Target.Offset(0, 1).Value * Target.Offset(0, 2).Value
Target.Offset(0, 4).Value = Target.Offset(0, 1).Value * Target.Offset(0, 2).Value * 0.0498
Target.Offset(0, 6).Value = Target.Offset(0, 5).Value / 10 * 5
Target.Offset(0, 9).Value = Target.Offset(0, 4).Value + Target.Offset(0, 6).Value + Target.Offset(0, 7).Value + Target.Offset(0, 8).Value
Target.Offset(0, 10).Value = Target.Offset(0, 3).Value - Target.Offset(0, 6).Value
End If
End Sub




2-) Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim RaBereich As Range
Set RaBereich = Range("A3:A100")
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
Application.EnableEvents = False
Cancel = True
If Target.Value = "X" Then
Target.Value = ""
Else
Target.Value = "X"
End If
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub


L3:L100 sütun aralığındaki 1 nolu makroya göre işlemini A3:A100 sütun aralığındaki "X" işareti varsa gerçekleştirecek yoksa 1. makro pasif kalacak. Abilerim buna göre düzenlye bilirler mi?

 

[baydeniro]

Sayın sirkülasyon. Basit bir koşullu makro çalışması yaptım, umarım işinize yarar. Aşağıdaki makro şöyle çalışıyor : butona basınca A1 hücresinde X yazılı ise DENEME makrosunu tetikler, yazılı değilse bir şey yapmaz.


Sub KOSUL()

If [a1] = "X" Then
Call DENEME
End If

End Sub

 

[sirkülasyon]

Serdar abi
Bir düğmeye bağlama yerine yukarıda bulunan makroşeklinde her ikisi birden çalışsa
1. koşul A sütununda X olacak
2. Koşul L sütununda Gerçek Usul, Basit Usul ya da Firma yazacak
2 koşul sağlanırsa işlem yapacak

 

[baydeniro]

Sayın sirkülasyon. Sütun olunca beni aşar. Benim yazdığım kod bir hücreye endeksli. 2 veya daha fazla hücre de olabilir ama sütun işinin ben beceremem. Ayrıca örnek dosya eklemelisin, örnek dosya üzerinden üstadlar daha kolay yardımcı olabilirler.

 

[mancubus]

A sütunundaki tüm X'ler için, L sütununda dao 3 değerden biri var ise çalışır.

Sub Sutunda_Varsa_Calis()
  
    Dim SonSat As Long, i As Long
    
    SonSat = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To SonSat
        If UCase(Range("A" & i)) = "X" And _
                (Range("L" & i) = "Gerçek Usul" Or _
                Range("L" & i) = "Basit Usul" Or _
                Range("L" & i) = "Firma") Then
            Call Deneme_Makrosu
        End If
    Next
End Sub

 

[sirkülasyon]

Teşekkür Ederim

 

[mancubus]

rica ederim.

 

[baydeniro]

Teşekkürler sayın mancubus, ben de çok faydalanırım bu koddan.

 

[mancubus]

rica ederim. çok sevindim işe yaramasına...