自查.VBA提取非空单元格

今天看到标题这个问题，比较实用。不禁想用vba实现一下，需要手动修改的地方：在代码中替换区域范围，sheet名称，以及安置的新列，亲测可用，代码如下：
Sub ExtractAndPlaceData()
Dim ws As Worksheet
Dim sourceRange As Range
Dim targetColumn As Range
Dim sourceCell As Range
Dim targetCell As Range
Dim numRows As Long
Dim numCols As Long
Dim i As Long
Dim j As Long
Dim rowIndex As Long

’ 修改 “Sheet1” 为你实际使用的工作表名称
Set ws = ThisWorkbook.Worksheets(“Sheet1”)
’ 设置源数据区域
Set sourceRange = ws.Range(“A1:D20”)
’ 设置目标列
Set targetColumn = ws.Range(“H1”)
’ 获取源数据区域的行数和列数
numRows = sourceRange.Rows.Count
numCols = sourceRange.Columns.Count
’ 初始化目标列的行索引
rowIndex = 1
’ 循环遍历源数据区域的每个单元格
For j = 1 To numCols
For i = 1 To numRows
Set sourceCell = sourceRange.Cells(i, j)
’ 如果单元格非空，则提取到目标列中
If Not IsEmpty(sourceCell.Value) Then
Set targetCell = targetColumn.Offset(rowIndex - 1, 0)
targetCell.Value = sourceCell.ValuerowIndex = rowIndex + 1
End If
Next i
Next j
End Sub