Question

Before图片代表员工报告的教育背景。如您所见，生成信息的报告会创建不需要的重复项和空格。对此无能为力。 After图片显示了我想要的最终结果。为了达到目的，我手动：

删除了重复项
将剩余的已占用单元格复制/粘贴到范围的顶部，而不会移动范围以下的任何单元格。（是的，有低于该范围的数据）。

如何使用VBA自动执行此操作？ Before图片代表范围F3：H18，我将范围命名为 edVal 。

此范围始终为3列（F-H）。行数会有所不同，但我已经有了选择edVal的代码，无论它有多少行。

我还有其他代码在工作表的其他地方做其他的事情，但后来我来到这个教育部分。假设我将edVal调整为Range并选择了edVal。似乎我需要的其他代码将适用于＆＃34;使用edVal＆＃34;并结束。

谢谢！

Answer 1

如下所示，它将删除重复项并循环通过F3到F18，如果它找到一个空白行，它将删除并向上移动，但它会在底部插入一个空行，从而留下您的数据低于该范围。

只需使用edVal中的值调整下面的代码：

Sub foo()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")

ws.Range("$F$3:$H$18").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo

For i = 3 To 18
If ws.Cells(i, "F").Value = "" Then
    ws.Range("F" & i & ":H" & i).Delete Shift:=xlUp
    ws.Range("F18:H18").Insert Shift:=xlDown
End If
Next i
End Sub

Answer 2

根据建议调整edVal的值。该代码位于＆＃34;与edVal / End With＆＃34;线。根据主持人的要求，还显示了我已经拥有的代码。

Sub foo()
Dim empRange as Range, edVal as Range
Dim f as Integer, l as Integer

Set empRange = Range("A3:Z18")   'rows 1 and 2 are headers
  With empRange
    f = empRange.Row
    l = empRange.Rows.Count
    Set edVal = Range(.Cells(, 6), .Cells(l, 8))  'edVal is columns F-H of the larger empRange
    With edVal
      .RemoveDuplicates Columns:=Array(1, 2, 3), HEADER:=xlNo
      For i = f To l + 2     'adding 2 to account for two header rows
        If Range("F" & i).Value = "" Then
          Range("F" & i & ":" & "H" & i).Delete Shift:=xlUp
          Range("F" & l + 2 & ":" & "H" & l + 2).Insert Shift:=xlDown
        End If
      Next I
    End With
  End With                    
End Sub

消除一定范围内的重复项，然后将非空白单元格移动到相同范围的顶部，而不将单元格移动到范围之外

2 个答案: