Aynı hücre içerisinde geçen yinelenen değerler hk.

[Mumtaz55]

Merhaba öncelikle iyi forumlar dilerim. Sorum şu şekilde;
- Aynı hücre içerisinde alt alta olacak şekilde veri ekliyorum. Bu verilerin her biri 9 karakter uzunluğunda (Örnek: 123456789)
- Makro kullanarak aynı hücre içerisinde aynı değerin geçmesi halinde karşıma bir uyarı penceresi çıkmasını istiyorum (Örnek: Tekrar eden değer bulundu vb.)
Bu konuda yardımlarınızı bekliyorum

 

[walabi]

Aynı hücre içersinde alt alta denmiş. Satırlardaki değerleri değil de hücre içine eklenen değerlerden bahsediliyor sanırım. Aynı hücre içersine alt + enter ile alt alta eklenen verilerin kontrolü gibi.

 

[muhasebeciyiz]

@walabi haklısın benim gözümden kaçmış

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim valueCount As Object
Dim cellValues As Variant
Dim i As Long
Dim value As String

Set valueCount = CreateObject("Scripting.Dictionary")

If Not Intersect(Target, Me.Range("A1:A99")) Is Nothing Then
For Each cell In Intersect(Target, Me.Range("A1:A99"))
If cell.value <> "" Then
cellValues = Split(cell.value, vbLf)

For i = LBound(cellValues) To UBound(cellValues)
value = Trim(cellValues(i))

If Len(value) <> 9 Then
MsgBox "Hücre içinde 9 karakterden oluşmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If Not IsNumeric(value) Then
MsgBox "Hücre içinde sayı olmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If valueCount.exists(value) Then
MsgBox "Tekrar eden değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
Else
valueCount.Add value, cell.Address
End If
Next i
End If
Next cell
End If
End Sub

Hücreye birden fazla sayı girildiğinde, her birini alt + Enter ile ayırarak kontrol eder.
Her bir değerin 9 karakter uzunluğunda olup olmadığını ve sayısal olup olmadığını denetler.
Ayrıca aynı hücre içinde tekrarlanan bir değeri de kontrol eder.
Bu kod, alt + Enter ile girilen her satırı doğru şekilde kontrol edecektir.

 

[Mumtaz55]

@walabi haklısın benim gözümden kaçmış

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim valueCount As Object
Dim cellValues As Variant
Dim i As Long
Dim value As String

Set valueCount = CreateObject("Scripting.Dictionary")

If Not Intersect(Target, Me.Range("A1:A99")) Is Nothing Then
For Each cell In Intersect(Target, Me.Range("A1:A99"))
If cell.value <> "" Then
cellValues = Split(cell.value, vbLf)

For i = LBound(cellValues) To UBound(cellValues)
value = Trim(cellValues(i))

If Len(value) <> 9 Then
MsgBox "Hücre içinde 9 karakterden oluşmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If Not IsNumeric(value) Then
MsgBox "Hücre içinde sayı olmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If valueCount.exists(value) Then
MsgBox "Tekrar eden değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
Else
valueCount.Add value, cell.Address
End If
Next i
End If
Next cell
End If
End Sub

Tam kontrol olmasada bir seviyeye geldi

Çok teşekkür ederim tam istediğim gibi oldu ilaveten birşey daha sormak istiyorum. C1:C500 arasında sayılar var fakat bunların başlıkları da var. Yani başlıklar 9 uzunluğunda sayı içermediğinden hata alıyorum. Makro içerisinde şöyle bir aralık belirlemem mümkün mü? Örneğin C3:C50 - C50:C70 - C80:C100 gibi

 

[muhasebeciyiz]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim valueCount As Object
Dim cellValues As Variant
Dim i As Long
Dim value As String
Dim checkRange As Range
Dim definedRanges As Variant
Dim r As Variant

Set valueCount = CreateObject("Scripting.Dictionary")

definedRanges = Array("C3:C50", "C50:C70", "C80:C100")

For Each r In definedRanges
Set checkRange = Me.Range(r)

If Not Intersect(Target, checkRange) Is Nothing Then
For Each cell In Intersect(Target, checkRange)
If cell.value <> "" Then
cellValues = Split(cell.value, vbLf)

For i = LBound(cellValues) To UBound(cellValues)
value = Trim(cellValues(i))

If Len(value) <> 9 Then
MsgBox "Hücre içinde 9 karakterden oluşmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If Not IsNumeric(value) Then
MsgBox "Hücre içinde sayı olmayan bir değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
End If

If valueCount.exists(value) Then
MsgBox "Tekrar eden değer bulundu: " & value, vbExclamation, "Uyarı"
Exit Sub
Else
valueCount.Add value, cell.Address
End If
Next i
End If
Next cell
End If
Next r
End Sub

Belirttiğiniz özel aralıklar (C3:C50, C50:C70, C80:C100) içinde değişiklik yapıldığında, yalnızca bu hücrelerin değerleri kontrol edilir.
Bu aralıklar dışındaki hücrelerde yapılan değişiklikler göz ardı edilir.
Alt + Enter ile girilen değerler, her satırda 9 karakter uzunluğunda ve sayısal olmalıdır. Ayrıca, her hücredeki değerler benzersiz olmalıdır.
Bu kod, başlıklar dışındaki aralıkları kontrol etmek için gayet uygundur. Başlıkların kontrol edilmesini istemediğiniz için belirli aralıkları net bir şekilde belirtmek, doğru hücrelerin kontrol edilmesini sağlar.

Deneyiniz

 

[Mumtaz55]

çok teşekkürler