- Katılım
- 10 Ekim 2011
- Mesajlar
- 40
- Excel Vers. ve Dili
- 2007-2010
- Altın Üyelik Bitiş Tarihi
- 18-01-2023
Dosya sekmesinde örnek ücretler yazan kısma yeni rakam getirme
Ekli dosyalar
-
10.1 KB Görüntüleme: 16
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=TOPLA.ÇARPIM((C2>=Sayfa1!$A$2:$A$9)*(C2<=Sayfa1!$B$2:$B$9);Sayfa1!$C$2:$C$9)
Sub kontrol()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, son As Long, son2 As Long, i As Long, x As Long
Set s1 = Sheets("DOSYA")
Set s2 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, 1).End(3).Row
son2 = s2.Cells(Rows.Count, 1).End(3).Row
s1.Range("D2:D" & son + 1).Clear
For i = 2 To son
For x = 2 To son2
If s1.Cells(i, "C") >= s2.Cells(x, "A") And s1.Cells(i, "C") <= s2.Cells(x, "B") Then
s1.Cells(i, "D") = s2.Cells(x, "C")
End If
Next x
Next i
Set s1 = Nothing: Set s2 = Nothing
son = 0: son2 = 0: i = 0: x = 0
Application.ScreenUpdating = True
End Sub