[已解决]抽取指定数据的问题

Baibdu

附件 提取指定数据.rar (27.85 KB, 下载次数: 9)

2014-6-7 16:26 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

刘苏

2014-6-7 16:47

1. Sub 提取()
   
2.     Dim Arr(), MyR&, Arr_R(), k&
   
3.     Columns("k").Clear
   
4.     Arr = Sheets(1).UsedRange.Value
   
5.     ReDim Arr_R(1 To UBound(Arr), 1 To 1)
   
6.     For MyR = 1 To UBound(Arr)
   
7.         If VBA.Mid(Arr(MyR, 1), Application.Find("-", Arr(MyR, 1)) + 1, 1) <> "" Then
   
8.             k = k + 1
   
9.             Arr_R(k, 1) = Arr(MyR, 1)
   
10.         End If
    
11.     Next MyR
    
12.     Range("k1").Resize(k, 1) = Arr_R
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

刘苏

1. Sub 提取()
   
2.     Dim Arr(), MyR&, Arr_R(), k&
   
3.     Columns("k").Clear
   
4.     Arr = Sheets(1).UsedRange.Value
   
5.     ReDim Arr_R(1 To UBound(Arr), 1 To 1)
   
6.     For MyR = 1 To UBound(Arr)
   
7.         If VBA.Mid(Arr(MyR, 1), Application.Find("-", Arr(MyR, 1)) + 1, 1) <> "" Then
   
8.             k = k + 1
   
9.             Arr_R(k, 1) = Arr(MyR, 1)
   
10.         End If
    
11.     Next MyR
    
12.     Range("k1").Resize(k, 1) = Arr_R
    
13. End Sub
    

复制代码

qh8600

Sub demo()
    Dim ar, br(), i, n
    ar = Sheet1.Range("a1:a" & [a1048576].End(3).Row)
    For i = 1 To UBound(ar)
        If Right(ar(i, 1), 1) <> "-" Then
            n = n + 1
            ReDim Preserve br(1 To UBound(ar), 1 To 1)
            br(n, 1) = ar(i, 1)
        End If
    Next
    Columns("k").Clear
    Range("k1").Resize(n, 1) = br
End Sub
我也练练

张雄友

刘苏 发表于 2014-6-7 16:47

如果A列有重复的话，不能忽略重复的。

张雄友

qh8600 发表于 2014-6-7 17:00
Sub demo()
    Dim ar, br(), i, n
    ar = Sheet1.Range("a1:a" & [a1048576].End(3).Row)

如果A列有重复的话，不能忽略重复的。

qh8600

张雄友 发表于 2014-6-7 20:10
如果A列有重复的话，不能忽略重复的。

谢谢老师指点，真不能去重，看来要用字典，不过这个字典要转置麻烦