EXCEL VB实现将所有数据移到第一列，并删除重复项和空格

Sub MoveColumn1()
    Dim ws As Worksheet
    Dim lastRowCol1 As Long, lastRow As Long, i As Long, j As Long
    Dim targetRow As Long
    Dim numCols As Long
    Dim insertSeparator As Boolean
    
    ' 设置工作表，这里假设是活动工作表
    Set ws = ActiveSheet
    
    ' 找到第一列最后一行的行号
    lastRowCol1 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 获取工作表中的总列数
    numCols = ws.UsedRange.Columns.Count
    
    ' 设置是否在第一列的每个数据块之间插入空行
    insertSeparator = True
    
    ' 从第二列开始循环到最后一列
    For j = 2 To numCols
        ' 找到当前列的最后一行的行号
        lastRow = ws.Cells(ws.Rows.Count, j).End(xlUp).Row
        
        ' 如果需要在当前数据块之前插入空行，并且不是第一列的数据块
        If insertSeparator And j > 2 Then
            targetRow = lastRowCol1 + 1
            ws.Cells(targetRow, 1).Value = "" ' 插入一个空行（或者你可以选择其他标记）
            lastRowCol1 = lastRowCol1 + 1 ' 更新第一列最后一行的行号
        End If
        
        ' 设置目标行号，从第一列最后一行的下一行开始
        targetRow = lastRowCol1 + 1
        
        ' 将当前列的数据作为一个块复制到第一列下面
        For i = 1 To lastRow ' 从第一行开始复制，包括标题（如果需要）
            ws.Cells(targetRow, 1).Value = ws.Cells(i, j).Value
            targetRow = targetRow + 1
        Next i
        
        ' 更新第一列最后一行的行号
        lastRowCol1 = targetRow - 1
    Next j
    
    ' 可选：清除其他列的数据（如果你不需要保留它们）
    For j = 2 To numCols
        ws.Columns(j).ClearContents
    Next j
    
    
    ' 找到第一列的最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
        ' 删除重复项
    ws.Range("A1:A" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    
    ' 重新找到第一列的最后一行
    lastRow1 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 设置要处理的范围
   ' Set Rng = ws.Range("A1:A" & lastRow1)
    
    ' 删除空格项（将空格项替换为空字符串）
    For i = lastRow1 To 1 Step -1 ' 从底部开始向上遍历，以避免在删除行时干扰循环
        If Trim(ws.Cells(i, 1).Value) = "" Then
            ws.Cells(i, 1).Delete Shift:=xlUp
       End If
    Next i
    

    
    'MsgBox "多列数据已作为块成功移动到第一列下面！"
End Sub