-2

请按照收集了一些任务详细信息的表格。现在我正在这些类型的 excel 表上寻找可以检查所有 TCompdate 列的任何 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

代码：

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

谢谢，

4

3 回答 3

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
 '======================
于 2012-12-13T17:07:27.683 回答
1

编辑：？？

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

编辑：添加变量，ChuckSize

编辑：还将车道startCol = objSheet1.Range("A1").column “A”更改为“S”，更改为您的 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
 '======================
于 2012-12-14T08:00:33.673 回答
0

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

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

于 2012-12-13T04:55:06.333 回答