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

Excel VBA宏：重新组织行并使用唯一标识符

2 个答案: