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

Question

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

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

期望在一个单元格中去除黑色和红色

终极需求

预期之前/之后

Answer 1

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

这是一个 VBA 函数，它将：

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

这是子程序：

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 中的值求和。第三个工作表是预期的工作表。 如果可能，感谢您的帮助。