Skip to main content

AccessTr.neT


Hücredeki Değere Göre Hesaplama Yapma

Hücredeki Değere Göre Hesaplama Yapma

#16
şimdilik sadece B ve C sütunları için
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 kodu
Private 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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
RE: Hücredeki Değere Göre Hesaplama Yapma - Yazar: berduş - 04/01/2022, 23:16
Task