Question

我无法在无休止的搜索后找到解决方案。这就是我想要做的事情：

我在一个Excel工作表中有单元格，可以在一列中包含日期和空单元格的混合。我想然后选择只有日期的单元格，然后将它们复制到另一个工作表中的相应列。它们必须以与第一张纸中完全相同的顺序粘贴，因为每行都附有标题。我用这段代码做对了：

Sub test_combine2()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    Dim i&, cl As Range, data As Range, splItem, key, s$
    Set data = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "A"))
    For Each cl In data
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'add in `Array()` another cells if required
        s = Join(Array(cl.Offset(, 1).Value2, _
                       cl.Offset(, 2).Value2, _
                       cl.Offset(, 3).Value2, _
                       cl.Offset(, 4).Value2), "|")
    'Currently `s` contains values from columns `B,C,D,E` - 4 values
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        If Not Dic.exists(s) Then
            Dic.Add s, cl.Value2
        Else
            Dic(s) = Dic(s) & "," & cl.Value2
        End If
    Next
    Workbooks.Add: i = 1
    For Each key In Dic
            Cells(i, "A").Value2 = Dic(key)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently in array 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
    Next key
End Sub

但是，第一张工作表中的日期每天都在更新，并且可能是第一张工作表上的一个标题尚未更新（在另一天），因为用户尚未检查它。如果我把它留空并且如果我遵循相同的程序那么它将覆盖＆＃34;第二张纸中的日期并将单元格留空，这是我不想要的。我希望我很清楚。有人可以帮助我吗？

此致

Answer 1

您可以使用Excel内置的AutoFilter和SpecialCells方法轻松完成此任务（并使用少量代码）。

With Sheets("RMDA").Range("D4:D25")

    .AutoFilter 1, "<>"

    Dim cel as Range
    For Each cel In .SpecialCells(xlCellTypeVisible)

        Sheets("Overview").Range("D" & cel.Row).Value = cel.Value

    Next

    .AutoFilter

End With

Answer 2

你可以尝试类似的东西。这将为您提供范围内的非空白，可能有更简单的方法......希望它有所帮助

Sub x()

Dim rStart As Excel.Range
Dim rBlanks As Excel.Range

Set rStart = ActiveSheet.Range("d1:d30")
Set rBlanks = rStart.SpecialCells(xlCellTypeBlanks)

Dim rFind As Excel.Range
Dim i As Integer
Dim rNonBlanks As Excel.Range

For i = 1 To rStart.Cells.Count
    Set rFind = Intersect(rStart.Cells(i), rBlanks)
    If Not rFind Is Nothing Then
        If rNonBlanks Is Nothing Then
            Set rNonBlanks = rFind
        Else
            Set rNonBlanks = Union(rNonBlanks, rFind)
        End If
    End If
Next i

End Sub

Answer 3

仅仅因为一个单元格是空白并不意味着它实际上是空的。

根据您对问题的描述，我猜测单元格实际上并不是空的，这就是将空白单元格复制到第二张单中的原因。

而不是使用＆＃34; IsEmpty＆＃34;函数我会计算单元格的长度，只复制长度大于零的那些

Dim i As Long

For i = 5 To 25

If Len(Trim((Sheets("RMDA").Range("A" & i)))) > 0 Then _

Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)

Next i

Trim从单元格中删除所有空格，然后Len计算单元格中字符串的长度。如果此值大于零，则它不是空白单元格，因此应复制。

选择＆amp;在Excel VBA中仅复制非空白单元格，不要覆盖

3 个答案: