[已解决]怎么删除列？

hahada

把第二行标题有dd  kk  aa  hh列的数据保留，其它标题所在的列删除

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-1-9 12:07

1.     Dim i As Integer
   
2.     Application.ScreenUpdating = False
   
3.     For i = Cells(2, Columns.Count).End(xlToLeft).Column To 1 Step -1
   
4.         Select Case Cells(2, i).Value
   
5.             Case "dd", "kk", "aa", "hh"
   
6.             Case Else
   
7.                 Columns(i).Delete
   
8.         End Select
   
9.     Next
   
10.     Application.ScreenUpdating = True
    
11.     MsgBox "ok"

复制代码

跳转到最佳答案楼层

yyyydddd8888

请测试：

删除列.rar (7.7 KB, 下载次数: 16)

2014-1-9 12:05 上传

点击文件名下载附件

1. Sub 删除()
   
2. Dim arr, brr(1 To 100000), i&, j&, k&, rg As Range
   
3.    arr = Range(Cells(2, 1), Cells(2, Columns.Count))
   
4.    For i = 1 To UBound(arr, 2)
   
5.        If arr(1, i) <> "dd" And arr(1, i) <> "kk" And arr(1, i) <> "aa" And arr(1, i) <> "hh" Then
   
6.           k = k + 1
   
7.           brr(k) = i
   
8.        End If
   
9.    Next i
   
10.    For j = 1 To k
    
11.        If rg Is Nothing Then
    
12.           Set rg = Cells(2, brr(j))
    
13.         Else
    
14.           Set rg = Union(rg, Cells(2, brr(j)))
    
15.        End If
    
16.    Next j
    
17.    rg.EntireColumn.Delete
    
18. End Sub
    

复制代码

hwc2ycy

1.     Dim i As Integer
   
2.     Application.ScreenUpdating = False
   
3.     For i = Cells(2, Columns.Count).End(xlToLeft).Column To 1 Step -1
   
4.         Select Case Cells(2, i).Value
   
5.             Case "dd", "kk", "aa", "hh"
   
6.             Case Else
   
7.                 Columns(i).Delete
   
8.         End Select
   
9.     Next
   
10.     Application.ScreenUpdating = True
    
11.     MsgBox "ok"

复制代码

hahada

都不错，评哪个为最佳？？？

sdfsdfs

Sub Macro1()
Dim rng As Range, i&, j&
w = Array("dd", "kk")
For i = 2 To Cells(7, Columns.Count).End(xlToLeft).Column
    For j = 0 To UBound(w)
        If Cells(7, i) = w(j) Then
            If rng Is Nothing Then Set rng = Cells(7, i) Else Set rng = Union(rng, Cells(7, i)): Exit For
        End If
    Next
Next
If Not rng Is Nothing Then rng.EntireColumn.Delete
End Sub