求教如何删除数组空白的数据

猪猪868宝贝2

计划对数据进行正反转置，基本已经完成，求教如何删除空白的数据，如图黄色部分，详见附件，谢谢。

hongshan2019

何为删除？后面的数据前移？

cao47112

hongshan2019 发表于 2022-11-23 16:44
何为删除？后面的数据前移？

我看他的意思是的，倒序之后数据左对齐

猪猪868宝贝2

hongshan2019 发表于 2022-11-23 16:44
何为删除？后面的数据前移？

嗯，是的，后面的数据前移

hongshan2019

猪猪868宝贝2 发表于 2022-11-23 16:47
嗯，是的，后面的数据前移

做循环的时候，可以判断每列的数量。crr赋值都从第一个开始

feilanga

新定义一个新数组，然后对原数组循环，不为空的装入新数组，新数组重新写入单元格

gwjkkkkk

请参考附件。。。

3190496160

Sub 数据正反转置()
Dim arr, brr, crr
Sheet1.Activate
With Sheet1
    x = .UsedRange.Rows.Count
    y = .Range("IV1").End(xlToLeft).Column  '最大列数
    arr = .Range(Cells(1, 1), Cells(x, y))
End With
ReDim brr(1 To UBound(arr), 1 To UBound(arr))
ReDim crr(1 To UBound(arr), 1 To UBound(arr))
For J = 1 To UBound(arr, 2)
    LH = 0: LHh = 0
    For I = 1 To UBound(arr)
        If Trim(arr(I, J)) <> "" Then
            LH = LH + 1
            brr(J, LH) = arr(I, J)
        End If
    Next I
    For I = UBound(arr) To 1 Step -1
        If Trim(arr(I, J)) <> "" Then
            LHh = LHh + 1
            crr(J, LHh) = arr(I, J)
        End If
    Next I
Next J
Sheet2.Activate
Cells.Delete Shift:=xlUp

Sheet2.Range("A1").Resize(UBound(arr, 2), UBound(arr)) = brr
l = Sheet2.Range("A65536").End(xlUp).Row
Sheet2.Range("A" & l + 1).Resize(UBound(arr, 2), UBound(arr)) = crr
MsgBox "ok!"
End Sub

3190496160

数据正反转置test.rar (18.29 KB, 下载次数: 1)

2022-11-23 17:41 上传

点击文件名下载附件

3190496160