Question

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

输入表格

 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

输出表

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

谢谢，

Answer 1

关闭计算和屏幕更新：

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)

   objExcel1.ScreenUpdating = False
   objExcel1.Calculation = -4135  'xlCalculationManual

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.ScreenUpdating = True
   objExcel1.Calculation = -4105   'xlCalculationAutomatic

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

Answer 2

编辑：??

编辑：添加我的样本输入＆amp;输出结果

编辑：变量添加，ChuckSize

编辑：也改变车道startCol = objSheet1.Range("A1").column ＆＃34; A＆＃34;到＆＃34; S＆＃34;，到您的PID所在的任何列，
假设：您的数据从第1行开始

使用@Tim的解决方案+ 2D阵列优化技术的解决方案。

示例输入：

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

Answer 3

为什么要使用vba-这可以通过公式来完成。对于表格中的第一个数据行，公式为

=D1 =IF(ISBLANK(D3),"",B3) =IF(ISBLANK(D3),"",C3) =IF(ISBLANK(D3),"",D3) =IF(ISBLANK(G3),"",E3)等

使用Vbscript使列无效

3 个答案: