- Katılım
- 18 Mayıs 2018
- Mesajlar
- 519
- Excel Vers. ve Dili
- 2007
- Altın Üyelik Bitiş Tarihi
- 11-06-2025
arkadaşalar burdaki dosya olur mu yapmak istediğimi excel içine yazdım
Ekli dosyalar
-
9 KB Görüntüleme: 25
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Calculate()
Dim a As Double, b As Double, c As Double
a = [B4]
b = [C4] - [D1]
c = Application.Max(a, b)
[B4] = c
End Sub
Private Sub Worksheet_Calculate()
Dim alan, s As Long, son As Long, i As Long, a As Double, b As Double
Dim x As Double, y As Double, z As Double
With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With
x = [B4]
y = [C4] - [D1]
z = Application.Max(x, y)
[B4] = z
son = Cells(Rows.Count, "A").End(xlUp).Row
alan = Range("A8:T" & son).Value
a = Range("A2").Value
b = Range("B2").Value
ReDim dizi(1 To son, 1 To 20)
For i = LBound(alan) To UBound(alan)
s = s + 1
dizi(s, 1) = alan(i, 2)
If Not IsError(alan(i, 3)) And Not IsError(alan(i, 20)) Then
If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = 0 Then
dizi(s, 1) = alan(i, 1)
End If
End If
Next i
Range("B8").Resize(s, 1) = dizi
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub