Snasui Excel Forum

Code: Select all

Sub Macro1()
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("h4", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 3).Value = r.Value + r.Offset(0, 1).Value
            End If
        Next r
    End With
End Sub

Code: Select all

Sub Macro_check2()
'ãÊè¤èÒã¹àªÅ
Range("Q5").Value = Range("L5").Value
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("L5", .Range("L" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
            End If
        Next r
    End With
End Sub

Code: Select all

Sub Macro_check2()
'ใส่ค่าในเชล
Range("Q5").Value = Range("L5").Value
    Dim i As Integer
    With Sheets(1)
        For i = 0 To Minute(Application.Text(.Range("L" & .Rows.Count).End(xlUp), "hh:mm:ss")) - 1
                Cells(5 + i, 12).Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
        Next i
    End With
End Sub

Code: Select all

Sub run()
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    r = r + 1
Next n
End Sub

Code: Select all

Sub Macro_check2()
'ใส่ค่าในเชล
Range("Q5").Value = Range("L5").Value
    Dim i As Integer
    With Sheets(1)
        For i = 0 To Minute(Application.Text(.Range("L" & .Rows.Count).End(xlUp), "hh:mm:ss")) - 1
                Cells(5 + i, 12).Offset(1, 5).Value = "=R[-1]C+(1/60/24)"
        Next i
    End With
End Sub

Code: Select all

Sub Macro_runtime()
'ãÊè¤èÒã¹àªÅ
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    r = r + 1
Next n
End Sub

Code: Select all

Sub Macro_runtime()
'ใส่ค่าในเชล
sd = Range("L5")
ed = Range("L1048576").End(xlUp) + TimeValue("00:01:00")
r = 5
For n = sd To ed Step TimeValue("00:01:00")
    Range("Q" & r) = n
    Range("R" & r) = "=IF(VLOOKUP(RC[-1],R5C12:R100000C13,1)=RC[-1],VLOOKUP(RC[-1],R5C12:R100000C13,2),0)"
    Range("R" & r) = Range("R" & r)
    r = r + 1
Next n
End Sub

Code: Select all

    Range("R" & r).Value = "=VALUE(TEXT(RC[-1],""dd/mm/yyyy""))"
    Range("R" & r).Value = Range("R" & r).Value
    Range("S" & r).Value = "=VALUE(TEXT(RC[-2],""hh:mm:ss""))"
    Range("S" & r).Value = Range("S" & r).Value
    Range("T" & r).Value = "=IF(VLOOKUP(RC17,R5C12:R100000C13,1)=RC17,VLOOKUP(RC17,R5C12:R100000C13,2),0)"
    Range("T" & r).Value = Range("T" & r).Value

Code: Select all

Dim dic As Object

Sub Macro_check1()
'ใส่ค่าในเชล ข้อแม้คือจนกว่าต่าด้านหน้าจะว่าง
    Dim r As Range
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        For Each r In .Range("h5", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 4).Value = r.Value + r.Offset(0, 1).Value
                If Not dic.exists(CStr(Left(r.Offset(0, 4).Value2, 12))) Then
                    dic.Add Key:=CStr(Left(r.Offset(0, 4).Value2, 12)), Item:=r.Offset(0, 2).Value
                End If
                r.Offset(0, 5).Value = r.Offset(0, 2).Value
            End If
        Next r
    End With
End Sub

Sub Macro_runtime()
'ใส่ค่าในเชล
    Dim arr(999999, 3) As Variant, r As Long
    Dim sd As Double, ed As Double, n As Date
    With Sheets(1)
        sd = .Range("L5").Value2
        ed = .Range("L" & .Rows.Count).End(xlUp).Value2 + TimeValue("00:01:00")
        For n = sd To ed Step TimeValue("00:01:00")
            arr(r, 0) = n
            arr(r, 1) = n - TimeValue(n)
            arr(r, 2) = TimeValue(n)
            If dic.exists(Left(CStr(CDbl(n)), 12)) Then
                arr(r, 3) = dic.Item(Left(CStr(CDbl(n)), 12))
            Else
                arr(r, 3) = 0
            End If
            r = r + 1
        Next n
        .Range("q5").Resize(r, 4).Value = arr
    End With
    MsgBox "Finished.", vbInformation
End Sub

Code: Select all

Sub Macro1()
    Dim r As Range
    With Sheets(1)
        For Each r In .Range("h4", .Range("h" & .Rows.Count).End(xlUp))
            If r.Value <> "" Then
                r.Offset(0, 3).Value = r.Value
            End If
        Next r
    End With
End Sub