使用Vbscript的列无效 [英] Column nullification using Vbscript

问题描述

请按照表中的一些任务详细信息进行收集。现在我正在寻找任何VBscript这些类型的Excel表，可以检查所有的TCompdate列，如果发现该列中没有值，那么它的相关两列说T，TSdate应为空白。

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:\VA\TestVBSScripts\DataNullification\DataNullification.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
 '======================

谢谢，

推荐答案

编辑：

编辑：添加我的样本输入&输出结果

ADD MY SAMPLE INPUT & OUTPUT RESULT

编辑：变量添加，ChuckSize

Variable added, ChuckSize

编辑：还更改车道 startCol = objSheet1.Range（A1）。列
A到S到您的PID的任何列，

假设：您的数据从第1行开始

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

使用@ Tim's Solution + 2D数组优化技术的解决方案。

A solution using @Tim's Solution + the 2D Array optimization tech.

strong>示例输入：

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

示例输出：

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                                              

代码：

 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:\Users\wangCL\Desktop\data.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
 '======================

这篇关于使用Vbscript的列无效的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！