Vbscript 使用VB脚本删除任何单元格中不包含数据的Excel列

如果Excel列中没有一个值，是否有更快的过程使用vb脚本删除该列

   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

现在VBScript应该给我一个计数，行1包含4个数据，行2包含2个数据，行3包含2个数据，如wise

代码更新

我已经根据你的代码更新了我的代码。并使用“Hi”作为弹出框，查看控件是否进入if主体。但弹出框从未出现。调用“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

修复：我刚刚修复了它。所以这里没有问题。只需您的帮助即可更新部分

---

谢谢

您可以使用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

---

你的想法很完美，除了我在代码中做了一点修改。我们需要使用递减循环，而不是递增循环。否则，Delete函数不会删除所有列。此处更改和更新的代码为：

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

---

谢谢你的回复。我不明白你的意思。你能帮我理解一下吗？在我的Excel中，我有300列，我需要检查该列是否有任何单一数据。所以我只能提供列号，而不是Range对象中的字母表。你知道怎么做吗？嗨，我已经为你发布了最终代码（通过索引选择的列）。希望我理解正确，并且您正在尝试删除单元格中没有值的列。否则，你可以稍微调整一下代码来做任何你想做的事情。你能在我下面的帖子中提供帮助吗？你能帮我更新一下上面的帖子吗？提前谢谢

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