Question

我正在尝试以最有效的方式使用VBA清理提供给我的excel数据集。我想比较工作表范围内3列的行值（＃可能有所不同），如果所有3列的行值都相同，那么我希望将相同行但不同列的值复制到一个单元格中。

样本集：应将红色复制到一个单元格中：

在一个单元格中删除了黑色并显示了红色的期望

最终想要

预期之前/之后

Answer 1

将来，SO问题应该是关于您遇到的特定问题，而不是一般性问题。

这是一个VBA函数，它将：

遍历每个单元格，直到找到一个空单元格。我们假设一旦找到一个空单元格，我们就位于您数据集的末尾。
检查前三列中的任何一列是否已更改其上一个单元格中的数据。如果有，这是我们的新“工作行”。我们将您的数据集合并到的行。
对于每一行，除非其已存在于该行中，否则将其值从数据集列添加到“工作行”中。
完成后，返回并删除空白单元格。

这是子例程：

Sub clean_dataset()
    Dim sh As Worksheet
    Dim rw As Range
    Dim workingRow As Integer
    Dim col1Value As String
    Dim col2Value As String
    Dim col3Value As String
    Dim rowCount As Integer

    workingRow = 1


    'Iterate through all rows on the sheet.  Stop if we get to an empty row.
    Set sh = ActiveSheet
    For Each rw In sh.Rows

        ' Exit if we get to an emptry row.
        If sh.Cells(rw.Row, 1).Value = "" Then
            Exit For
        End If

        ' Check if our three columns to watch have changed value.  If they have, we should be in a new 'working row'
        If rw.Row > 1 Then
            If (Range("A" & rw.Row).Value <> Range("A" & rw.Row - 1).Value) Or (Range("B" & rw.Row).Value <> Range("B" & rw.Row - 1).Value) Or (Range("C" & rw.Row).Value <> Range("C" & rw.Row - 1).Value) Then
                workingRow = rw.Row
            End If
        End If


        ' Get the values in the current row from the dataset we are trying to consolidate.
        col1Value = Range("D" & rw.Row).Value
        col2Value = Range("E" & rw.Row).Value
        col3Value = Range("F" & rw.Row).Value


        ' Add the values to the working row cells, if they do not already exist
        If InStr(Range("D" & workingRow).Value, col1Value) = 0 Then
            Range("D" & workingRow) = Range("D" & workingRow).Value & vbLf & col1Value
        End If
        If InStr(Range("E" & workingRow).Value, col2Value) = 0 Then
            Range("E" & workingRow) = Range("E" & workingRow).Value & vbLf & col2Value
        End If
        If InStr(Range("F" & workingRow).Value, col3Value) = 0 Then
            Range("F" & workingRow) = Range("F" & workingRow).Value & vbLf & col3Value
        End If


        ' As long as we are not in the working row, delete the values
        If rw.Row <> workingRow Then
            Range("D" & rw.Row) = vbNullString
            Range("E" & rw.Row) = vbNullString
            Range("F" & rw.Row) = vbNullString
        End If

        rowCount = rw.Row

    Next rw
    ' End of for each




    ' Go back through, and delete any rows that do not have values in column D
    For iter = rowCount To 1 Step -1

        ' If all three columns are blank, delete the row.
        If Range("D" & iter).Value = vbNullString Then
            sh.Rows(iter).Delete
        End If

    Next

End Sub

希望这会有所帮助。

Answer 2

经过一番搜索，我终于找到了这篇非常适用的帖子，因为我的问题与 OP 类似。

我正在处理三张工作表，其中工作表 1 是源，工作表 2 是检查表，工作表 3 是我将从工作表 2 粘贴/清理数据的位置。

在 Sheet1 中，我复制 Col C 中的值并在 Sheet2 - Col C 中对其进行过滤，对于 Col J 中的每个公司，我需要检查 Col K 中的交易量，如果交易量 >/= 1，则该行需要复制/粘贴到第 3 表中，同时合并行的每个单元格中相应的唯一值并删除重复项并对 col K 中的值求和。第三个表是预期的表。如果可能，感谢您的帮助。

如果工作表中的3列值相同，如何将单元格内容从多行复制到一个单元格中？

2 个答案: