我有一张像这样的table
Initial Table
开始日期和结束日期包含公式,您可以在公式栏中看到。希望将范围拆分为半小时时间间隔,因此表格将如下所示
Result Table
任何宏代码的想法,我可以运行这种情况下?我也希望宏可以自动运行,并容纳一个小时以上的时间间隔。
无论如何,我从另一个用户那里尝试了这段代码,当时间格式不是公式时,它工作正常,但是当我把它改为公式时,它显示错误类型不匹配
代码1
Sub sample()
Dim bufF As String, bufT As String, NO As String, name As String, day As
String, Min As String, Min2 As String
Dim i As Long, j As Single, LastR1 As Long, LastR2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim x() As String, y() As String, cnt As Long
Set ws1 = Sheets("data") '<--change the sheet name
Set ws2 = Sheets("result") '<--change the sheet name
With ws1
LastR1 = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastR1
NO = .Cells(i, 1).Value
name = .Cells(i, 2).Value
bufF = InStr(Format(.Cells(i, 4).Value, "ddmmyyyy hh:mm"), " ")
bufF = Mid(Format(.Cells(i, 4).Value, "ddmmyyyy hh:mm"), bufF + 1, 2)
bufT = InStr(Format(.Cells(i, 5).Value, "ddmmyyyy hh:mm"), " ")
bufT = Mid(Format(.Cells(i, 5).Value, "ddmmyyyy hh:mm"), bufT + 1, 2)
Min = InStr(Format(.Cells(i, 4).Value, "ddmmyyyy hh:mm"), ":")
Min = Mid(Format(.Cells(i, 4).Value, "ddmmyyyy hh:mm"), Min + 1, 2)
Min2 = InStr(Format(.Cells(i, 5).Value, "ddmmyyyy hh:mm"), ":")
Min2 = Mid(Format(.Cells(i, 5).Value, "ddmmyyyy hh:mm"), Min2 + 1, 2)
day = Format(.Cells(i, 4).Value, "dd-mm-yyyy ")
If bufT = "00" Then bufT = 24
With ws2
LastR2 = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim x(bufT * 2 - bufF * 2)
ReDim y(bufT * 2 - bufF * 2)
If Min = "30" Then bufF = bufF + 0.5
If Min2 = "30" Then bufT = bufT + 0.5
For j = bufF * 1 To bufT * 1 - 0.5 Step 0.5
If j = Int(j) Then
x(cnt) = day & j & ":00"
y(cnt) = NO & "-" & j
cnt = cnt + 1
Else
x(cnt) = day & Int(j) & ":30"
y(cnt) = NO & "-" & j
cnt = cnt + 1
End If
Next j
.Range(.Cells(LastR2 + 1, 1), .Cells(LastR2 + cnt, 1)).Value =
WorksheetFunction.Transpose(y)
.Range(.Cells(LastR2 + 1, 3), .Cells(LastR2 + cnt, 3)).Value =
WorksheetFunction.Transpose(x)
.Range(.Cells(LastR2 + 1, 2), .Cells(LastR2 + cnt, 2)).Value =
name
End With
cnt = 0
Next
End With
End Sub
代码2
Sub RevisedSample()
Dim myName As String 'Name could be confused with the Excel '.Name'
property.
Dim StartTime As Date, EndTime As Date
Dim Activity As String, Detail As String
Dim LastRowSource As Long, LastRowDestination As Long, LoopCountSource As
Long, LoopCountDestination As Long
Dim ThirtyMinInterval As Boolean: ThirtyMinInterval = False 'Explicitly
assigning False to variable
Dim StringStartTime As String, StringEndTime As String
Dim Time As String
Dim TimeArray As Variant
Dim ArrayCounter As Long
Set SourceSheet = Sheets("Sheet1") '<--change the sheet name
Set DestinationSheet = Sheets("Sheet2") '<--change the sheet name
With SourceSheet
LastRowSource = .Cells(Rows.Count, 1).End(xlUp).Row
For LoopCountSource = 2 To LastRowSource
myName = .Cells(LoopCountSource, 1).Value
Activity = .Cells(LoopCountSource, 2).Value
StartTime = .Cells(LoopCountSource, 4).Value
EndTime = .Cells(LoopCountSource, 5).Value
If DateDiff("n", StartTime, EndTime) > 30 Then
ThirtyMinInterval = True
StringStartTime = CStr(StartTime)
StringEndTime = CStr(EndTime)
Time = InStr(Format(StringStartTime, "ddmmyyyy hh:mm"), " ")
Time = Mid(Format(StringStartTime, "ddmmyyyy hh:mm"), Time + 1, 2)
Time = Time & ":30"
StringEndTime = Format(Mid(StringStartTime, 1, 8), "dd/mm/yyyy") &
" " & Time
ReDim TimeArray(1 To 2)
TimeArray(1) = StartTime
TimeArray(2) = CDate(StringEndTime)
End If
Detail = .Cells(LoopCountSource, 3).Value
With DestinationSheet
LastRowDestination = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If ThirtyMinInterval = True Then
ArrayCounter = 1
For LoopCounterDestination = LastRowDestination To
LastRowDestination + (UBound(TimeArray) - 1)
.Range("A" & LoopCounterDestination).Value = myName
.Range("B" & LoopCounterDestination).Value =
TimeArray(ArrayCounter)
.Range("C" & LoopCounterDestination).Value = Activity
.Range("D" & LoopCounterDestination).Value = Detail
ArrayCounter = ArrayCounter + 1
Next LoopCounterDestination
Else
.Range("A" & LastRowDestination).Value = myName
.Range("B" & LastRowDestination).Value = StartTime
.Range("C" & LastRowDestination).Value = Activity
.Range("D" & LastRowDestination).Value = Detail
End If
End With
ThirtyMinInterval = False
Next LoopCountSource
End With
End Sub
对于第二个代码,它需要修改,因此它将容纳超过一个小时的时间间隔
1条答案
按热度按时间nfs0ujit1#
试试看,
数据表
结果表