☰

如何将具有多个值的 Excel 行规范化/展平为具有单个值的单行？

tag-icon • tag-icon microsoft-excel worksheet-function vba
如何将具有多个值的 Excel 行规范化/展平为具有单个值的单行？

源在顶部转换为底部

我有一张 Excel 表格，我的用户在其中统计了她在飞行期间观察到的动物数量。我必须找到一种方法将她的输入分成多行，每行只有一种动物类型。从示例中，您可以看到她看到了与当天、航线和航路点相关的 5 只动物（2 种类型）（即 AE 列）--> 我需要做的是使用 2 行显示，因为原始行上有 2 个条目。最后，有 36 列可以包含计数值，大约有 9000 个原始行需要浏览。

我根本不精通 VBA。如果你们能给我指点迷津，我应该能够搞定一些事情。

谢谢 Layne

答案1

手动操作的方法（36 个周期仍然需要一些工作，但远少于 9000 行）是复制工作表并删除除一列动物计数数据之外的所有列。对每个所需的列执行此操作。然后将所有工作表的结果剪切并粘贴到一张工作表上，制作一个大表。使用排序将所有日期按行重新组织在一起。

答案2

各位：这是我最终想到的办法。还有一个类可以简单地充当集合。如果有更有效的方法来做到这一点，请告诉我。

{选项明确

函数 LastRowWithData_xlUp_1() As Long ' LS 从 Web 抓取 '使用 End(xlUp) 确定一列（B 列）中包含数据的最后一行 'Rows.count 返回工作表的最后一行（在 Excel 2007 中为 1,048,576）；Cells(Rows.count, "B") 返回单元格 B1048576，即 B 列中的最后一个单元格，代码从此单元格开始向上移动；代码基本上执行 Range("B1048576").End(xlUp)，并且 Range("B1048576").End(xlUp).Row 最后返回最后一个行号。LastRowWithData_xlUp_1 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

结束函数

函数 LastColumnWithData_xlToLeft() As Long ' LS 从 Web 抓取 '使用 End(xlToLeft) 确定一行中包含数据的最后一列（行号 1） LastColumnWithData_xlToLeft = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

结束函数

Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean ' LS Grabbed from Web ' 此函数将查看指定的工作表是否存在。 如果 InWorkbook 为 Nothing 则设置 InWorkbook = ThisWorkbook Dim Sheet As Object 对于 InWorkbook.Sheets 中的每个工作表 如果 sheetToFind = Sheet.Name 则 sheetExists = True 退出函数 End If Next Sheet sheetExists = False End Function

Sub Normalizer() ' 由 Layne Seely 创建，并得到 Jon 的大力支持。 ' 声明一些与活动 Excel 工作簿和所需工作表相关的变量。 Dim wbWB As Workbook Dim wsWkSt1 As Worksheet Dim wsWkSt2 As Worksheet

' Declare some counters for rows, columns and a couple of general counters.
Dim iColCnt As Integer
Dim iRwCnt As Integer
Dim i As Integer
Dim j As Integer

' Declare some variables for the Class Module.
Dim col As New Collection
Dim PageNumber As String
Dim WMU As Integer
Dim DateVal
Dim WPT As Integer
Dim Line As Integer
Dim pr As clPreface
Dim colID As Integer
Dim p As Integer
Dim StartRow As Integer

' Set some Variable values to start them off.
iColCnt = 0
iRwCnt = 0
StartRow = 3
Set wbWB = ActiveWorkbook
Set wsWkSt1 = wbWB.ActiveSheet

' Check to see if Sheet2 (our created output) exists and create it if not.
If sheetExists("Sheet2") <> True Then
    Set wsWkSt2 = wbWB.Worksheets.Add(Type:=xlWorksheet)
    wsWkSt2.Name = "Sheet2"
End If

' Copy the Header row over to Sheet2.
iColCnt = Application.WorksheetFunction.CountA(wsWkSt1.Range("2:1"))
For i = 1 To iColCnt
    wsWkSt1.Cells(1, i).Copy Destination:=wsWkSt2.Cells(1, i)
    wsWkSt1.Cells(2, i).Copy Destination:=wsWkSt2.Cells(2, i)
Next i

' Get a count of the number or rows in the origanl data.
iRwCnt = Application.WorksheetFunction.CountA(wsWkSt1.Range("A:A"))

' Status update for the User.
MsgBox (" Reading the entire dataset - this may take a while. ")

' Read through the entire dataset collecting the necessary values into a collection of objects.
For i = 3 To iRwCnt

    ' Get the first 5 cells, the preface.
    PageNumber = wsWkSt1.Cells(i, 1)
    WMU = wsWkSt1.Cells(i, 2)
    DateVal = wsWkSt1.Cells(i, 3)
    WPT = wsWkSt1.Cells(i, 4)
    Line = wsWkSt1.Cells(i, 5)

    ' Begin stepping though each cell on row "i" collecting the non-blank cell values and their column index value.
    For j = 6 To iColCnt
        If wsWkSt1.Cells(i, j) <> vbNullString Then

            ' Create a new empty Preface Class Object.
            Set pr = New clPreface

            ' Set the values of the Preface object to the values of row "i".
            With pr
                .PageNumber = PageNumber
                .WMU = WMU
                .DateVal = DateVal
                .WPT = WPT
                .Line = Line
                .colID = j
                .Score = wsWkSt1.Cells(i, j)
            End With

            ' Add this row's values to the collection.
            col.Add pr

            ' Clear out the preface for the next non-blank column.
            Set pr = Nothing
        End If

    ' Increment the Column index.
    Next j

' increment the Row index.
Next i

' Status update for the User.
MsgBox (" Writing the output dataset - this may take a while. ")

' Begin writing out all of the objects in the collection to the output worksheet.
For p = 1 To col.Count
    Set pr = col.Item(p)

    With pr
        colID = .colID
        wsWkSt2.Cells(StartRow, 1) = .PageNumber
        wsWkSt2.Cells(StartRow, 2) = .WMU
        wsWkSt2.Cells(StartRow, 3) = .DateVal
        wsWkSt2.Cells(StartRow, 4) = .WPT
        wsWkSt2.Cells(StartRow, 5) = .Line
        wsWkSt2.Cells(StartRow, colID) = .Score
    End With

    Set pr = Nothing
    StartRow = StartRow + 1
Next

' Tell the User that the processing is now completed.
MsgBox (" End of Processing. ")

子目录结束

}

相关内容