Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
305 views
in Technique[技术] by (71.8m points)

excel - Column nullification using Vbscript

Please follow the table where some tasks details have been gathered.Now i am looking for any VBscript on these types of excel sheet which can check all the TCompdate column,If it is found there is no value in that column then its related two columns say here T,TSdate should be blank.

Input Table

 PID     T1     T1Sdate   T1Compdate   T2      T2Sdate     T2Compdate   T3    T3Sdate   T3Compdate

 10      A     2/5/11      4/5/11      B      06/09/12                  C     11/11/11
 11      A     2/5/11                  B      06/09/12     8/8/10       C     11/11/11   5/4/11
 12      A     2/5/11                  B      06/09/12     8/8/10       C     11/11/11   5/4/11

Output Table

 PID     T1     T1Sdate   T1Compdate   T2      T2Sdate     T2Compdate   T3    T3Sdate   T3Compdate

 10      A     2/5/11      4/5/11                        
 11                                    B      06/09/12     8/8/10       C     11/11/11   5/4/11
 12                                    B      06/09/12     8/8/10       C     11/11/11   5/4/11

CODE:

   Option Explicit

  Dim objExcel1,objWorkbook
  Dim strPathExcel1
  Dim objSheet1,IntRow1
  Dim Counter

   Set objExcel1 = CreateObject("Excel.Application")
   strPathExcel1 = "D:VATestVBSScriptsDataNullificationDataNullification.xlsx"

   Set objWorkbook=objExcel1.Workbooks.open(strPathExcel1)
   Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

IntRow1=2
Do While objSheet1.Cells(IntRow1,1).Value <> ""

For Counter=2 to 13 Step 3

 If objSheet1.Cells(IntRow1,Counter+2).Value = "" Then

 objSheet1.Cells(IntRow1,Counter).Value=""
 objSheet1.Cells(IntRow1,Counter+1).Value=""

 End If

Next


 IntRow1=IntRow1+1
 Loop

  '=======================
 objExcel1.ActiveWorkbook.SaveAs strPathExcel1
 objExcel1.Workbooks.close
 objExcel1.Application.Quit
 '======================

Thanks,

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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
 '======================

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...