• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

formülü koda çevirmek

Katılım
27 Şubat 2008
Mesajlar
307
Excel Vers. ve Dili
Office 2016
a1 hücresinde EĞER(METNEÇEVİR('1'!D6;"GG/AA/YYYY")=0;"";METNEÇEVİR('1'!D6;"GG/AA/YYYY")) kodum var
Bunu 75000 satıra aşağı çekiyorum ama bu işlem çok uzun sürüyor. ( bunun gibi 15 sutun olduğu için) ben bu formülü nasıl koda çeviririm.

Makro kaydetten kodu çevirdim.
Range("a1").Select
ActiveCell.FormulaR1C1 = _
"=IF(TEXT('1'!R[2]C[-4],""GG/AA/YYYY"")=0,"""",TEXT('1'!R[2]C[-4],""GG/AA/YYYY""))"
Range("a1").Select
Selection.AutoFill Destination:=Range("a1:a75000"), Type:=xlFillDefault

Maksadım sadece hızlı olmasını sağlamak.
 
Örnek dosya olsaydı iyi olurdu.

Aşağıdaki kodlar 1 adlı sayfanın 4. yani D sütunundan itibaren 18. yani R sütununa kadar sırayla kontrol eder.

Her sütunda 6. satırdan itibaren son dolu satıra kadar hücrelere bakar.

Eğer hücrede tarih varsa aktif olan sayfanın A1 hücresinden başlayarak aynı tarihi yazar. A1'i de diğer sayfadaki satır ve sütun değişimine göre değiştirir:

PHP:
Sub tarihle()
Application.ScreenUpdating = False
    For sutun = 4 To 18
        sonsatis = WorksheetFunction.Max(6, Sheets("1").Cells(Rows.Count, sutun).End(3).Row)
        For satir = 6 To sonsatir
            If IsDate(Sheets("1").Cells(satir, sutun)) = True Then
                ActiveSheet.Cells(sat - 5, sutun - 3) = Format(Sheets("1").Cells(satir, sutun), "dd/mm/yyyy")
            Else
                ActiveSheet.Cells(sat - 5, sutun - 3) = ""
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

Ancak yine de çok hızlı olmaz.
 
Geri
Üst