EDIT:??
EDIT: ADD MY SAMPLE INPUT & OUTPUT RESULT
EDIT: Variable added, ChuckSize
EDIT: also change the lane startCol = objSheet1.Range("A1").column
The "A" to "S", to whatever column your PID is at,
assumption made: Your data starts from row 1
A solution using @Tim's Solution + the 2D Array optimization tech.
Sample Input:
A A A A A A A A A A PID T1Name T1StartDate T1FinishDate Total Time Spent T2Name T2StartDate T2FinishDate Total Time Spent T3Name T3StartDate T3FinishDate Total Time Spent
A A A A A A A A A A 11 S1 12/7/2012 19/7/2012 100 19/7/2012
A A A A A A A A A A 12 S1 12/7/2012 S2 19/7/2012
A A A A A A A A A A 13 12/7/2012 11/5/2012 S6 12/5/2010
Sample Output:
A A A A A A A A A A PID T1Name T1StartDate T1FinishDate Total Time Spent T2Name T2StartDate T2FinishDate Total Time Spent T3Name T3StartDate T3FinishDate Total Time Spent
A A A A A A A A A A 11 S1 12/7/2012 19/7/2012 100
A A A A A A A A A A 12
A A A A A A A A A A 13
Code:
Option Explicit
Dim objExcel1,objWorkbook
Dim strPathExcel1
Dim objSheet1,IntRow1
Dim Counter
dim height
dim i
dim dataArray
dim startCol
dim j
dim chuckSize
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "C:UserswangCLDesktopdata.xlsx"
Set objWorkbook=objExcel1.Workbooks.open(strPathExcel1)
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets("data (4)")
objExcel1.ScreenUpdating = False
objExcel1.Calculation = -4135 'xlCalculationManual
startCol = objSheet1.Range("K1").column 'column with PID is
chuckSize = 4
Height = objSheet1.Cells(objSheet1.Rows.Count, startCol).End(-4162).Row '-4162 is xlUp
If Height >= 2 Then
ReDim dataArray(Height - 2, 12) '12 columns in total
dataArray = objSheet1.Range(objSheet1.Cells(2, startCol + 1), objSheet1.Cells(Height, startCol + 12)).Value
For i = 1 To Height - 1
For Counter = 1 To 12 Step chuckSize
If dataArray(i, Counter + chuckSize-1) = "" Then
For j = 0 to chuckSize - 2
dataArray(i, Counter + j) = ""
next
End If
Next
Next
'assigning the values back into the worksheet
objSheet1.Range(objSheet1.Cells(2, startCol + 1), objSheet1.Cells(Height, startCol + 12)).Value = dataArray
End If
objExcel1.ScreenUpdating = True
objExcel1.Calculation = -4105 'xlCalculationAutomatic
'=======================
objExcel1.ActiveWorkbook.Save
objExcel1.Workbooks.close
objExcel1.Application.Quit
'======================
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…