[已解决]能不能把代码改成数组？

hadha

Sub ABC()
    Dim i As Integer
    Application.ScreenUpdating = False
    For i = Cells(2, Columns.Count).End(xlToLeft).Column To 1 Step -1
        Select Case Cells(2, i).Value
            Case "dd", "kk", "aa", "hh"
            Case Else
                Columns(i).Delete
        End Select
    Next
    Application.ScreenUpdating = True
End Sub

Sub DEF()
    For i = [IV2].End(xlToLeft).Column To 1 Step -1
        If InStr("|aa|hh|kk|dd|", "|" & Cells(2, i) & "|") = 0 Then
            Columns(i).Delete
        End If
    Next
End Sub

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-23 17:01

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, s%
   
3. arr = Range("a2").CurrentRegion
   
4. Range("a2").CurrentRegion.Clear
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6. For j = 1 To UBound(arr, 2)
   
7.     If arr(1, j) <> "dd" And arr(1, j) <> "kk" Then
   
8.         s = s + 1
   
9.         For i = 1 To UBound(arr)
   
10.             brr(i, s) = arr(i, j)
    
11.         Next
    
12.     End If
    
13. Next
    
14. Range("a2").Resize(UBound(brr), s) = brr
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

那妳雨季

不是很懂。哪里要改为数组

tedxing

太厉害了

hadha

Sub abc1()
    Dim i, ar(1 To 256), n
    For i = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
        If InStr("dd,kk", Cells(2, i)) = False Then
            n = n + 1
            ar(n) = Cells(2, i)
        End If
    Next
    [2:2] = ""
    [a2].Resize(1, n) = ar
End Sub

Sub abc2()
    Dim ar, br(), i As Integer
    ar = Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column)
    ReDim br(1 To 1, 1 To UBound(ar, 2))
    For i = 1 To UBound(ar, 2)
        If ar(1, i) = "dd" Or ar(1, i) = "kk" Then
            j = j + 1
            br(1, j) = ar(1, i)
        End If
    Next
    [a2].Resize(, 99) = ""
    [a2].Resize(, j) = br
End Sub

su45

没附件，看代码猜题意，费劲！

hadha

su45 发表于 2014-4-21 10:06
没附件，看代码猜题意，费劲！

第二行标题有dd aa hh ff kk等，只要标题不是dd和kk，就把该标题所在的列删除
附件： 附件.rar (1.89 KB, 下载次数: 18)

2014-4-21 10:56 上传

点击文件名下载附件

pengyx

sub ddkk()
ar = sheet1.usedrange
redim br(1 To ubound(ar, 2))
for i = 1 To ubound(br)
    if ar(1, i) <> "dd" and ar(1, i) <> "kk" then
        n = n + 1
        br(n) = application.index(ar, 0, i)
    end if
next
for j = 1 To n
    sheet1.cells(2, j + 5).resize(ubound(ar), 1) = br(j)
next
end sub
试一试哈，行不行不知道

hadha

pengyx 发表于 2014-4-22 00:14
sub ddkk()
ar = sheet1.usedrange
redim br(1 To ubound(ar, 2))

sub ddkk()
ar = sheet1.usedrange
redim br(1 To ubound(ar, 2))
for i = 1 To ubound(br)
    if ar(1, i) <> "dd" and ar(1, i) <> "kk" then
        n = n + 1
        br(n) = application.index(ar, 0, i)
    end if
next
for j = 1 To n
    sheet1.cells(2, j + 5).resize(ubound(ar), 1) = br(j)
next
end sub

hadha

pengyx 发表于 2014-4-22 00:14
sub ddkk()
ar = sheet1.usedrange
redim br(1 To ubound(ar, 2))

应该是删除，不是添加复制

fffox

hadha 发表于 2014-4-22 11:10
应该是删除，不是添加复制

看一下，就是这个效果吧