Cuma, 18 Mart 2022
  3 Cevaplar
  9.8K Ziyaret
Kimyasal ürünlerin analitik testleri için trend verileri için bir elektronik tablo hazırlıyorum. Söz konusu verilerin transkripsiyonu gözden geçiren tarafından doğrulandıktan sonra her bir veri satırının kilitlenmesini istiyorum. VBA'da bu kodu kullanarak tek bir satırı kilitleyebiliyorum:

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Range("X3") = "Hayır" ise
Aralık("B3:W3").Kilitli = Yanlış
ElseIf Range("X3") = "Evet" O zaman
Aralık("B3:W3").Kilitli = Doğru
Eğer son
End Sub

Sütun X, iki seçenek olarak "Evet" ve "Hayır" olan bir açılır liste içerir. Sayfaya eklenen her veri satırının, gözden geçiren kişi bu sütunda evet'i seçtikten sonra, geçmiş verilerde istenmeyen değişiklikler yapılmadığından emin olmak için kilitlenmesini istiyorum. Bu, her satır için yaklaşık kodunu süresiz olarak tekrarlamak zorunda kalmadan mümkün müdür?
2 yıl önce
·
#2529
Kabul Edilen Cevap
Merhaba StephanieS,

Lütfen aşağıdaki kodu deneyin, başka sorularınız varsa, lütfen bana sormaktan çekinmeyin.

Amanda

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer

xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next

If (Target.Column <> 24) Then
Exit Sub
End If

Row = Target.Row


If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If


End Sub
2 yıl önce
·
#2522
Ayrıca, elektronik tablo korunurken bu hücrelerin durumunu kilitli değil kilitli olarak değiştirebilmem gerekiyor, aksi takdirde bu özellik işe yaramaz.
2 yıl önce
·
#2529
Kabul Edilen Cevap
Merhaba StephanieS,

Lütfen aşağıdaki kodu deneyin, başka sorularınız varsa, lütfen bana sormaktan çekinmeyin.

Amanda

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer

xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next

If (Target.Column <> 24) Then
Exit Sub
End If

Row = Target.Row


If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If


End Sub
2 yıl önce
·
#2531
Çok teşekkür ederim! Bu kod mükemmel çalıştı. VBA'da hala çok yeniyim, bu yüzden yardımınız için gerçekten minnettarım! :)
  • Sayfa:
  • 1
Bu gönderi için henüz cevap yok.