VBA提取非空单元格数据

精灵学VBA

高手帮个忙吧，先谢了！！！！！

jyieo

=IFERROR(INDEX(A$1:A$30,SMALL(IF(A$1:A$30<>"",ROW($1:$30)),ROW(A1))),"")
公式来一个

abc123281

Sub test()
Dim arr, brr
With Worksheets("sheet2")
  r = .Cells(.Rows.Count, 1).End(xlUp).Row
  arr = .Range("a1:a" & r)
  ReDim brr(1 To UBound(arr), 1 To 1)
  For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
      k = k + 1
      brr(k, 1) = arr(i, 1)
    End If
  Next
.Range("b1").Resize(k, 1) = brr
End With
End Sub

精灵学VBA

abc123281 发表于 2019-1-22 20:39
Sub test()
Dim arr, brr
With Worksheets("sheet2")

谢谢大师！！！！！！！！！！！！！！！！！好用！！！！！

everbest2015

Sub 提取非空数据()
    Dim ar, br(), i&, r&
    r = Cells(Rows.Count, 1).End(xlUp).Row
    ar = Range("a1:b" & r)
    [B:B].ClearContents
    r = 0
    ReDim br(1 To Application.CountA([A:a]), 1 To 1)
    For i = 1 To UBound(ar)
        If ar(i, 1) <> "" Then
            r = r + 1
            br(r, 1) = ar(i, 1)
        End If
    Next
    [b1].Resize(r) = br
End Sub

kzg2013

Sub aa()

Dim ar() As Variant
r = Range("a" & Rows.Count).End(xlUp).Row
Rng = Application.Transpose(Range("a1:a" & r)) '2d to 1d
s = Join(Rng, " ")
Set re = CreateObject("vbscript.regexp")
With re
.Pattern = "[0-9\u4e00-\u9fa5]+"
.Global = True
.ignorecase = True
Set tx = .Execute(s)
End With

For k = 0 To tx.Count - 1
ReDim Preserve ar(t)
ar(t) = tx.Item(k)
t = t + 1
Next k

Cells(1, 2).Resize(tx.Count, 1) = Application.Transpose(ar)





End Sub

tzdxy

Sub a()
Range("b:b").ClearContents
Range("a:a").SpecialCells(xlCellTypeConstants, 23).Copy Range("b1")
End Sub

三票

abc123281 发表于 2019-1-22 20:39
Sub test()
Dim arr, brr
With Worksheets("sheet2")

如何提取多列非空内容（比如：A-F列）

无雨谷

学习一下，谢谢