Question

我有一个名为＆＃34; GetData＆＃34;的工作表。在此工作表中有更多列。

A(Names)|B...   |C(Center)
++++++++|+++++++|+++++++++
Alpha   |       |100-Base
Beta    |       |110-2nd
Charly  |       |100-Base

现在我想把它们分成另一个名为＆＃34;概述＆＃34;的工作表。像这样：

A(Grouped)
++++++++++
100-Base
Alpha
Charly
110-2nd
Beta

我想我需要一个数组，但我不知道如何构建它。我试着这个开始：

     Sub unique4()
        Dim arr As New Collection, a
        Dim aFirstArray() As Variant
        Dim i As Long

        Dim LastRow As Long
        LastRow = Worksheets("GetData").Cells(Worksheets("GetData").Rows.Count, "C").End(xlUp).Row

        aFirstArray() = Worksheets("GetData").Range("C2:C" & LastRow).Value


        On Error Resume Next
        For Each a In aFirstArray
           arr.Add a, a
        Next

        For i = 1 To arr.Count
           Cells(i, 1) = arr(i)
        Next
     End Sub

Answer 1

这应该只用Excel公式解决您的问题。如果你想要一个vba解决方案，那当然也是可能的。

在新的工作表中，在A栏中，它就像：

A栏

您可以通过在单元格A3中输入以下内容来获得此格式，并根据需要将其下拉（将单元格A1，A2设置为值1）。

=A1+1

在B栏中，您将输入间接公式。在单元格B1中，输入：

=INDIRECT("Sheet1!A"&A1)

在Cell B2中，输入：

=INDIRECT("Sheet1!C"&A2)

A列将跟踪要从哪一行获取，然后间接公式将动态构建公式以获取值。希望它有所帮助！

Answer 2

这是一个没有数组，

Sub unique4()

Dim i As Long
Dim lastrow As Long
Dim j As Long
Dim tws As Worksheet

Set tws = Sheets("Sheet2")'Change to desired sheet output name.
j = 1
With Sheets("GetData")
    lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row

    For i = 1 To lastrow
        If i <> 1 Then
            If .Cells(i, 3) <> .Cells(i - 1, 3) Then
                tws.Cells(j, 1) = .Cells(i, 3)
                j = j + 1
                tws.Cells(j, 1) = .Cells(i, 1)
                j = j + 1
            Else
                tws.Cells(j, 1) = .Cells(i, 1)
                j = j + 1
            End If
        Else
            tws.Cells(j, 1) = .Cells(i, 3)
            j = j + 1
            tws.Cells(j, 1) = .Cells(i, 1)
            j = j + 1
        End If
    Next
End With

End Sub

One Caveat，您需要对C列上的数据进行排序才能正常工作。

Answer 3

不排序任何数据或类似的东西：

Sub test()
Dim LastRow As Long, i As Long, j As Long, k As Long, chkB As Boolean
Dim wsGet As Worksheet, wsPut As Worksheet
Set wsGet = ThisWorkbook.Worksheets(1)
Set wsPut = ThisWorkbook.Worksheets(2)
Const FirstRow As Long = 3
LastRow = wsGet.Range("C" & wsGet.Rows.Count).End(xlUp).Row
For i = FirstRow To LastRow
  chkB = True
  For j = FirstRow To i - 1
    If wsGet.Cells(i, 3) = wsGet.Cells(j, 3) Then chkB = False: Exit For
  Next
  If chkB Then
    k = k + 1
    wsPut.Cells(k, 1) = wsGet.Cells(i, 3)
    For j = i To LastRow
      If wsGet.Cells(j, 3) = wsGet.Cells(i, 3) Then
        k = k + 1
        wsPut.Cells(k, 1) = wsGet.Cells(j, 1)
      End If
    Next
  End If
Next
End Sub

我想我需要一个阵列，但我不知道如何构建它

3 个答案: