DAKİKAYA ÇEVİRME

[tnt5234xml]

SAAT GÜN VE AY BAZLI OLAN VERİLERİ DAKİKAYA ÇEVİRMEM LAZIM OTOMATİK OLARAK çok uğraştığım halde çözemedim forumdaki üstadlar yardımcı olabilirlerse çok sevinirim

 

[tnt5234xml]

1300 tane böyle verim var

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener mesiniz?
Kodlar büyük küçük harf duyarlı değildir. Veride gün yerine Gün varsa dakika olarak kabul eder.
Kodun içine koymaya üşendim onu da siz halledersiniz sanırım.

Sub Makro1()
   
    Dim i   As Long, _
        j   As Integer, _
        t   As Long, _
        d
   
    On Error Resume Next
    Application.ScreenUpdating = False
   
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
   
        d = Split(Application.WorksheetFunction.Trim(Cells(i, "A")), " ")
        t = 0
       
        For j = 0 To UBound(d) Step 2
            If d(j + 1) = "ay" Then
                t = t + d(j) * 43200
            ElseIf d(j + 1) = "gün" Then
                t = t + d(j) * 1440
            ElseIf d(j + 1) = "saat" Then
                t = t + d(j) * 60
            Else
                t = t + d(j)
            End If
        Next j
       
        Cells(i, "B") = t
       
    Next i
   
    Application.ScreenUpdating = True
   
    MsgBox "Hesaplama Bitmiştir...."
   
End Sub

 

[Tevfik_Kursun]

Sayın tnt5234xml arkadaşım,
Rakamlar harflere yapışık olmamalı. (A314 - A315 gibi)
İyi çalışmalar

 

[tnt5234xml]

sistemden otomatik geliyor sadece bir kısmını attım

 

[tnt5234xml]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener mesiniz?
Kodlar büyük küçük harf duyarlı değildir. Veride gün yerine Gün varsa dakika olarak kabul eder.
Kodun içine koymaya üşendim onu da siz halledersiniz sanırım.

Sub Makro1()
  
    Dim i   As Long, _
        j   As Integer, _
        t   As Long, _
        d
  
    On Error Resume Next
    Application.ScreenUpdating = False
  
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
  
        d = Split(Application.WorksheetFunction.Trim(Cells(i, "A")), " ")
        t = 0
      
        For j = 0 To UBound(d) Step 2
            If d(j + 1) = "ay" Then
                t = t + d(j) * 43200
            ElseIf d(j + 1) = "gün" Then
                t = t + d(j) * 1440
            ElseIf d(j + 1) = "saat" Then
                t = t + d(j) * 60
            Else
                t = t + d(j)
            End If
        Next j
      
        Cells(i, "B") = t
      
    Next i
  
    Application.ScreenUpdating = True
  
    MsgBox "Hesaplama Bitmiştir...."
  
End Sub

çok teşekkür ederim sayın necdet bey