怎么复制加删除

xing_chen

老师，有表，需表中的部分，但此部分含有空格。怎么可以复制此部分并删除空个所在行。敬请老师赐教！谢谢

xing_chen

老师！我的代码：Sub 删空格行()
    Range("A4:J100").Copy
    Range("L4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Columns("M:O").Delete Shift:=xlToLeft
    Columns("P:S").Delete Shift:=xlToLeft
    Range("M4:M100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("R17").Select
End Sub

此代码会将表的左半部分删除，这样就缺少了对比效果。敬请老师用其它办法达到又删有不影响原表。谢谢！

xing_chen

发的信息，怎么还未审核完呀?

xing_chen

xing_chen 发表于 2023-2-27 13:55
发的信息，怎么还未审核完呀?

老师！多少字就需要审核呀？可以告诉我吗啊？我就尽量压缩字数。如50年以前发电报一样。谢谢

ykcbf1100

用数组就可以。

tiger1976

Sub lll()

    Dim arr()
    Dim arr1
    Dim i As Integer
    Dim k As Integer
   
    Range("m16:n16") = Array("商品型号", "出")
    Range("n17:p17") = Array("数量", "单价", "金额")
    Range("m16:m17").Merge
    Range("n16:p16").Merge
   
    arr1 = Range("a1").CurrentRegion
    For i = 4 To UBound(arr1) - 1
        If arr1(i, 5) <> "" Or arr1(i, 5) <> 0 Then
            k = k + 1
            ReDim Preserve arr(1 To 4, 1 To k)
            arr(1, k) = arr1(i, 1)
            arr(2, k) = arr1(i, 5)
            arr(3, k) = arr1(i, 6)
            arr(4, k) = arr1(i, 7)
        End If
    Next
    Range("m18:p" & 17 + UBound(arr, 2)) = Application.WorksheetFunction.Transpose(arr)

End Sub

xing_chen

ykcbf1100 发表于 2023-2-27 14:21
用数组就可以。

谢谢老师！运行如愿。

xing_chen

tiger1976 发表于 2023-2-27 14:23
Sub lll()

    Dim arr()

谢谢老师！运行如愿。

gwjkkkkk

参与一下。。。

xing_chen

gwjkkkkk 发表于 2023-2-27 15:25
参与一下。。。

谢谢老师！运行如愿！