从Excel中的行中提取唯一值

Posted 2021-04-17

我需要将行中的唯一值汇总到同一行中的列中。我的目标是附加图像的第二行，其中T:Z包含数据，AA:AC包含摘要（我输入了演示的值）。第一行是当前发生的情况，我尝试使用嵌套的if函数获取大于零的值，但我也尝试使用索引匹配函数无效。问题是我要么在AA:AC中收到重复项，要么包含所有值。

目前使用Excel 2016

答案

因此，如果我理解正确，您将拥有一行数据。您希望查看列T：Z，然后在AA：AC列中生成唯一值列表（非零）。我假设你知道你永远不会有超过3个唯一值，但我不能确定这不仅仅是一个遗漏。

无论哪种方式，下面的代码应该工作：

Sub Find_Uniques()
    Dim X As Integer, Y As Integer, Z As Integer
    Dim Temp_Strings() As String
    For X = 1 to 10000 'This assumes you don't have more than 10,000 rows of data
        ReDim Temp_Strings(1 to 5) As String
        For Y = 20 to 26
            If Range(Cells(X,Y).Address).Value <> "" And Range(Cells(X,Y).Address).Value <> 0 Then
                For Z = 1 to 5
                    If Temp_Strings(Z) = "" Then
                        Temp_Strings(Z) = Range(Cells(X,Y).Address).Value
                        Exit For
                    End If
                    If Temp_Strings(Z) = Range(Cells(X,Y).Address).Value Then Exit For
                Next Z
            End If
        Next Y
        For Z = 1 to 5
            If Temp_Strings(Z) <> "" Then Range(Cells(X,Z+26).Address)).Value = Temp_String(Z)
        Next Z
    Next X
End Sub

另一答案

感谢大家的帮助。我没有从行中提取数据，而是编写了一个宏，将零更改为空白，删除了空白单元格，并将它们移动到左侧。之后，很容易切割范围并将其粘贴到要分析的旧数据集中。

Sub clean_data()
Sheets("Reason data").Range("H:Z").Replace 0, ""

Call delete_blanks
End Sub
Sub delete_blanks()

Sheets("Reason data").Range("H:Z").SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)

Call move_data

End Sub
Sub move_data()
'Copies reason data and pastes it into data worksheet

Sheets("Reason data").Range("A3:K3", Sheets("Reason data").Range("A3:F3").End(xlDown)).Cut _
Sheets("Data").Range("A1").End(xlDown).Offset(1)
End Sub