hata durumunda ilgili satırın B hücresinin rengi kırmızı oluyor.
Mesela: B sütununda "TEMEL BETON" yazarken L sütununda "TEMEL BETON " yani L'de en sonda fazladan boşluk var
çalışmanızda L sütunu ile B sütunundaki verileri eşleştirirken dikkatli olun dikkatten kaçan fazladan bir boşluk hataya sebebep oluyor mesela
1 - bir modul oluşturup aşağıdaki kodları yapıştırın
Option Compare Text
Function xHesapla(ByVal Rng As Range) ' As String
xRng = WorksheetFunction.Trim(Rng.Value)
xRef = VLookupFonksiyonu(Rng.Worksheet, Rng) 'xB_Dict(xRng)
xBDgr = IIf(xRng = "MEMBRAN", 100, 75)
xCDgr = Rng.Offset(, 1)
If Not IsNumeric(xCDgr) Then xCDgr = 0: Rng.Offset(, 1).Interior.Color = vbRed Else Rng.Offset(, 1).Interior.Color = xlNone
xRow = Rng.Row
Rng.Offset(, 3) = xCDgr * xRef 'E
Rng.Offset(, 4) = xCDgr * xRef * (xBDgr / 100) 'F
Rng.Offset(, 5).Formula = "=F" & xRow & "+ G" & xRow - 1 'G
Rng.Offset(, 6) = xCDgr * xRef * ((100 - xBDgr) / 100) 'H
End Function
Function VLookupFonksiyonu(Sht As Worksheet, ByVal Rng As Range)
On Error GoTo hata
Dim xMDgr As Double
xDgr = WorksheetFunction.Trim(Rng.Value)
xMDgr = WorksheetFunction.VLookup(xDgr, Sht.Range("L:M"), 2, 0)
hata:
If Err.Number = 1004 Then xMDgr = 0: Rng.Interior.Color = vbRed Else Rng.Interior.Color = xlNone
VLookupFonksiyonu = xMDgr
End Function
2 - işlem görülecek sayfanın Worksheet_Change olayının koduPrivate Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:C")) Is Nothing Then 'sadece B,C sütununa bakar
Application.EnableEvents = False
On Error GoTo hata
Dim cll As Range
AdrX = Target.Address & ":" & Target.Address
xDz = Split(AdrX, "$")
ilk = xDz(2)
Son = Val(xDz(4))
If ilk = "1:" Then ilk = "2:"
If Son < 2 Then Son = 2
Set Trgt = Range("B" & ilk & "B" & Son)
For Each cll In Trgt
Set Rng = cll
xHesapla (Rng)
Next cll
End If
hata:
Application.EnableEvents = True
End Sub