-1

その列に単一の値が含まれていない場合、vbスクリプトを使用してExcel列を削除するより高速なプロセスはありますか?

   For Task=2 To 300

   Vcounter="False"
   IntRow6=2

   Do While objSheet6.Cells(IntRow6,1).Value = ""

  If objSheet6.Cells(IntRow6,Task).Value <> "" Or objSheet6.Cells(IntRow6,Task).Value <> "None"


   Vcounter="True"
   Exit DO

  End If

 IntRow6=IntRow6+1
 Loop

  If  Vcounter <> "True" Then

   objSheet6.Cells(1,Task).EntireColumn.Delete

  End If

 Next

アップデート：

Excel の各行のデータ数を数える方法も教えてください。例えば

        Col1   Col2  Col3   Col4   Col5

  Row1   A       B            X     P
  Row2   L       M
  Row3                 T            V

これで、VBScript は、Row1 には 4 つのデータが含まれ、Row2 には 2 つのデータが含まれ、Row3 には wise のように 2 つのデータが含まれていることをカウントする必要があります。

コードの更新

あなたのコードを参照してコードを更新しました。そして、ポップアップボックスとして「Hi」を使用して、コントロールがIf Bodyに入ったかどうかを確認しました.しかし、ポップアップは決して来ませんでした. "Application.WorksheetFunction.CountBlank(rg)" の呼び出しで問題が発生したようです。ここで確認して助けてもらえますか？削除されるべき列はありません。

Sub DeleteColumns(Ob6)
     Dim CountBlank 
     Dim rows 
     Dim rg,c
  Set objExcel1 = CreateObject("Excel.Application")

 For c = 150 To 155
    Set rg = Ob6.Range(Ob6.Columns(c),Ob6.Columns(c))
    CountBlank = objExcel1.Application.WorksheetFunction.CountBlank(rg)
    rows = rg.rows.Count

    If CountBlank = rows Then
        MsgBox("Hi")
        rg.EntireColumn.Delete
    End If
 Next
End Sub

修正: 修正したばかりなので、問題ありません。更新部分についてはあなたの助けが必要

ありがとう

4

2 に答える 2

2

Application.WorksheetFunction 内にある関数 CountBlank を使用できます。

Dim CountBlank As Long
CountBlank = Application.WorksheetFunction.CountBlank(Range("A:A"))

次に、それを同じ範囲内の行数と比較するだけです。

Dim ws As Worksheet
Dim rows As Long
Set ws = ThisWorkbook.Worksheets(1)
rows = ws.Range("A:A").Count

インデックス 1 から 300 までの空の列を削除するためのコード全体は、次のようになります。

Sub DeleteColumns()
    Dim CountBlank As Long
    Dim ws As Worksheet
    Dim rows As Long
    Set ws = ThisWorkbook.Worksheets(1)
    Dim rg As Range

    For c = 1 To 300
        Set rg = Range(ws.Columns(c), ws.Columns(c))
        CountBlank = Application.WorksheetFunction.CountBlank(rg)
        rows = rg.rows.Count

        If CountBlank = rows Then
            rg.EntireColumn.Delete
        End If
    Next
End Sub
于 2012-12-11T13:19:57.507 に答える
0

コードに少し変更を加えたことを除いて、あなたのアイデアは完璧でした。Increment ループの代わりに Decrement For ループを使用する必要があります。そうしないと、削除機能によってすべての列が削除されるわけではありません。変更および更新されたコードは次のとおりです。

Sub DeleteColumns(Ob6)
  Dim CountBlank 
  Dim rows 
  Dim rg,c

  For c = 155 To 150 step - 1
    Set rg = Ob6.Range(Ob6.Columns(c),Ob6.Columns(c))
    CountBlank = objExcel1.Application.WorksheetFunction.CountBlank(rg)
    rows = rg.rows.Count
         'MsgBox("CountBlank:"&CountBlank)
         'MsgBox("Count:"&rows)
    If CountBlank = (rows-1) Then ' Rows-1 means the count should start from the 2nd row onward

        rg.EntireColumn.Delete

    End If
 Next

End Sub
于 2012-12-12T04:43:32.290 に答える