ŞARTLARA GÖRE HÜCRE SIFIRLAMA

[kardelen79]

Excel dosyasının içine de yazdım şu an çalışan bir makroda var bu makroyu biraz geliştirmek istiyorum yardım cı olursanız sevinirim

 

[Ömer]

Merhaba,

Deneyiniz.

Private Sub Worksheet_Calculate()

   Dim a, b, alan, s As Long, son As Long, i As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
  
    'a = Range("a2").Value
    'b = Range("b2").Value
  
    son = Cells(Rows.Count, "A").End(xlUp).Row
    'alan = Range("A8:T" & son).Value
    alan = Range("A8:AO" & son).Value
  
    'ReDim dizi(1 To son, 1 To 20)
    ReDim dizi(1 To son, 1 To 41)
  
    For i = LBound(alan) To UBound(alan)
        s = s + 1
        a = alan(i, 40) 'ilave
        b = alan(i, 41) 'ilave
        If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = "0" Then
            dizi(s, 1) = alan(i, 1)
        Else
            dizi(s, 1) = alan(i, 2)
        End If
    Next i
  
    Range("B8").Resize(s, 1) = dizi
  
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub

 

[kardelen79]

Abi sanki D8:300 ve E8:E300 hücrelerini baz almıyor devamlı sıfırlıyor A2 ve B2 Hücrelerini devre dışı bırakmamız lazım

 

[Ömer]

A2 ve B2 devri dışı bırakılmıştı. Kodlarda yeşil bölümler pasiftir.

Ben açıklamanızda D yada E sütunu değil AN ve AO sütunu gördüm ve ona göre yazdım.

 

[kardelen79]

a2 ve b2 değerlerinin yerine artık hersatırın karşısında bulunan D8:300 ve E8:E300 arasını baz alacak bütün fiyatların % desine göre hesaplayıp D ve E sütunlarına getiriyorum abi

 

[Ömer]

Eklediğiniz dosyadaki açıklama aşağıdadır.

A2 VE B2 baz almayacak her satır kendi satırında bulunan (AN8….....VE AO9....) değerlerini baz alabilirmi

 

[kardelen79]

abi dosyayı değiştirmiştim tekrar yükleyince yukarıdaki dosya farklı evet abi önceki dosya öylemişti (

 

[Ömer]

Private Sub Worksheet_Calculate()

   Dim a, b, alan, s As Long, son As Long, i As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With

    son = Cells(Rows.Count, "A").End(xlUp).Row
    alan = Range("A8:T" & son).Value
 
    ReDim dizi(1 To son, 1 To 20)
 
    For i = LBound(alan) To UBound(alan)
        s = s + 1
        a = alan(i, 4)
        b = alan(i, 5)
        If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = "0" Then
            dizi(s, 1) = alan(i, 1)
        Else
            dizi(s, 1) = alan(i, 2)
        End If
    Next i
 
    Range("B8").Resize(s, 1) = dizi
 
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub

 

[kardelen79]

burası
ReDim dizi(1 To son, 1 To 20)
21 sütun yapınca hata veriyor abi bir sütun eklemiştim

 

[kardelen79]

ömer abi birde saniye ekleyebilirmiyiz çok hızlı yapıyor ben saniyesini kendim ayarlasam kitlenmesin diye

 

[Ömer]

21. sütunu kodlar kullanıyor musunuz ki?

alan = Range("A8:T" & son).Value

T yerine U

 

[kardelen79]

Evet abi bir sutun ekleyince sağa kaydı ve busefer 20 sutunda başka rakamlar vardı T yi U yapınca düzeldi abi birde sisteme saniye formulüde eklersek süper olacak

 

[kardelen79]

 

[kardelen79]

Burda neresi hatalı ki ?

 

[Ömer]

3-4-5-21 sütunlarda herhangi bir satırda hata veren hücre var mı? #YOK, #DEĞER... vs türünde hata.

 

[kardelen79]

21 sütunda oluyor abi sistem açılmadığı zaman birde devamlı sıfırlıyor değerleri baz almıyor sace 21 sütunu baz alıyor

 

[kardelen79]

Ekli dosyayı görüntüle 223772

 

[kardelen79]

abi c sütunu 0 lıyor devamlı

 

[kardelen79]

Ama c8 ve c9 hücrelerinde 21 sütnda 0 dan yukarı olduiçin sıfırlamıyor burası çalışıyor

 

[kardelen79]