Excel VBA宏：重新组织行并由唯一标识符分隔

Question

因此，我有了这个excel表，其中列出了许多记录号和对记录的投诉。

该表的设置异常，因为每个记录＃的投诉都与记录号显示在同一行。

因此，如果一条记录有10条投诉，则有关每个投诉的信息（一个接一个）在与记录＃相同的行中列出。

我想创建一个VBA宏，该宏可以捕获所有在同一行中列出的所有投诉，并按记录号将其分隔到各自的行中。 我提供了原始表的屏幕快照以及我想象的输出结果。

我是VBA的新手，我想我只是没有语言来描述这个问题。 有人可以帮忙吗？

原始表

示例输出

Answer 1

我希望我理解这项权利。 基本上，您想一遍又一遍地检查每一行，看是否有投诉。 如果有投诉，则应将其提取到其他工作表中。 尝试获取表的长度，然后检查“投诉日期”中的每个单元格。 如果有日期，则在另一张工作表/表格/等中显示整行。我希望这段代码可以很好地工作。

Dim counter, lastrow As Integer
counter = 1
lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row  'finds the last row in column A
For i = 1 To lastrow
    If Cells(i,2) <> "No Complaints" Then
        Cells(counter,x)    'Write the cell where you want(counter to have them one under the other)
        counter = counter + 1
    End If
Next i

Answer 2

假设工作表输入包含所有数据的表，那么您需要创建一个空表并将其命名为输出。

在新模块中应用以下代码

Sub test()
    Worksheets("Input").Select
    Dim lastrow As Long
    Dim lastcolumn As Long
    Dim printatsheet2 As Long
    Dim actualset As Long
    Dim recordno As String
    Dim complaintdate As Date
    Dim walkin As String
    Dim conclusive As String
    Dim typej As String
    Dim typex As String
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
    printatoutput = Worksheets("Output").Range("A" & Rows.Count).End(xlUp).Row + 1
    actualset = (lastcolumn - 1) / 5
    For i = 2 To lastrow
        recordno = Cells(i, 1)
        For j = 1 To actualset
        If j = 1 Then
            dd = j + 1 '7 '13
            ee = (j + 5) '12 '18
        Else
            dd = dd + 5
            ee = ee + 5
        End If
            For k = dd To ee
                If Cells(1, k) = "Complaint Date" And (Cells(i, k) <> "No Complaints" And Cells(i, k) <> "") Then
                    complaintdate = Cells(i, k)
                ElseIf Cells(1, k) = "#Walkin" Then
                    walkin = Cells(i, k)
                ElseIf Cells(1, k) = "#Conclusive" Then
                    conclusive = Cells(i, k)
                ElseIf Cells(1, k) = "#TypeJ" Then
                    typej = Cells(i, k)
                ElseIf Cells(1, k) = "#TypeX" Then
                    typex = Cells(i, k)
                End If
            Next k
            If complaintdate = CDate(0) And walkin = "" And conclusive = "" And typej = "" And typex = "" Then
                'nothing
            Else
                With Worksheets("Output")
                    .Cells(printatoutput, 1) = recordno
                    .Cells(printatoutput, 2) = complaintdate
                    .Cells(printatoutput, 3) = walkin
                    .Cells(printatoutput, 4) = conclusive
                    .Cells(printatoutput, 5) = typej
                    .Cells(printatoutput, 6) = typex
                    printatoutput = printatoutput + 1
                End With
                'If complaintdate = CDate(0) Then complaintdate = CDate(0) Else complaintdate = complaintdate
                complaintdate = CDate(0)
                walkin = ""
                conclusive = ""
                typej = ""
                typex = ""
            End If
        Next j
    Next i
End Sub