[]
excel bilirkişileri bir bakabilir mi?
Aşağıdaki iki kodu excel vba’de nasıl birleştirebilirim?
Kod1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then
Target.Offset(0, 1).ClearContents
Target.Offset(0, 2).ClearContents
Target.Offset(0, 3).ClearContents
Target.Offset(0, 4).ClearContents
Target.Offset(0, 5).ClearContents
Target.Offset(0, 6).ClearContents
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
Target.Offset(0, 9).ClearContents
Target.Offset(0, 10).ClearContents
Target.Offset(0, 11).ClearContents
End If
End Sub
Kod2
Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32,H2:H32"))
If Not xxx Is Nothing Then
If HasValidation(xxx) Then
Exit Sub
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
End If
End If
End Sub
Private Function HasValidation(r) As Boolean
HasValidation = True
On Error Resume Next
For Each cll In r.Cells
x = cll.Validation.Type
If Err.Number <> 0 Then
HasValidation = False
Exit For
End If
Next cll
End Function
cevap veren arkadaşlara şimdiden teşekkürler.
Kod1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then
Target.Offset(0, 1).ClearContents
Target.Offset(0, 2).ClearContents
Target.Offset(0, 3).ClearContents
Target.Offset(0, 4).ClearContents
Target.Offset(0, 5).ClearContents
Target.Offset(0, 6).ClearContents
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
Target.Offset(0, 9).ClearContents
Target.Offset(0, 10).ClearContents
Target.Offset(0, 11).ClearContents
End If
End Sub
Kod2
Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32,H2:H32"))
If Not xxx Is Nothing Then
If HasValidation(xxx) Then
Exit Sub
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
End If
End If
End Sub
Private Function HasValidation(r) As Boolean
HasValidation = True
On Error Resume Next
For Each cll In r.Cells
x = cll.Validation.Type
If Err.Number <> 0 Then
HasValidation = False
Exit For
End If
Next cll
End Function
cevap veren arkadaşlara şimdiden teşekkürler.
butona ata ikisini de?
- kablelvuku (08.07.19 13:52:27)
@kablelvuku
soru sahibine ilettim şöyle bir cevap yazdı:
" Deniyorum ama olmuyor
İlk satırda parantez içinde yer alanları bir yere yazmam lazım
Hata veriyor
Private Sub Worksheet_Change(ByVal Target As Range)
Şunları nasıl yazacağım o zaman
Onu anlamadım"
soru sahibine ilettim şöyle bir cevap yazdı:
" Deniyorum ama olmuyor
İlk satırda parantez içinde yer alanları bir yere yazmam lazım
Hata veriyor
Private Sub Worksheet_Change(ByVal Target As Range)
Şunları nasıl yazacağım o zaman
Onu anlamadım"
- syozkn (08.07.19 14:22:48)
1