excel - Vbscript を使用した列の無効化

Question

いくつかのタスクの詳細が集められた表に従ってください。今、私はすべての TCompdate 列をチェックできるこれらのタイプの Excel シートで任意の VBscript を探しています。その列に値がない場合、その関連する 2 つの列は言うここで、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
 '======================

ありがとう、

score 1 · Accepted Answer

編集：？？

編集：私のサンプル入力と出力結果を追加

編集: 変数が追加されました, ChuckSize

編集：また、レーンstartCol = objSheet1.Range("A1").column を「A」から「S」に変更し、PIDがどの列にあるかに関係なく、
仮定：データは行1から始まります

@Tim のソリューション + 2D Array 最適化技術を使用したソリューション。

サンプル入力:

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

score 1 · Accepted Answer

計算と画面更新をオフにする:

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

score 0 · Accepted Answer

そもそもvbaを使用する理由-これは式で行うことができます。テーブルの最初のデータ行の数式は次のとおりです。

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

excel - Vbscript を使用した列の無効化

3 に答える 3

Related