Question

我有一个动态的数据集，意味着N个行和N个列（组）。第一个屏幕截图是数据在3组中的外观，但正如我所说，它可能是N个组。也可以有N个项目。

初始数据：

第二个屏幕截图显示了数据的外观。我需要为每个分数（该行中的数值）编写项目名称。所以我必须以某种方式转置数据。我需要遍历列，但不知道如何在循环中划分组，因为它们具有相同的列标题。只有定义和组号始终是唯一的。

这必须在VBA中完成。

循环遍历行和列并“转置”后的最终数据：

由于

编辑：这是我到目前为止尝试过的代码，它在集合之间留下了空格，只适用于第一组。

    Sub transposeData()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim lastCol As Long
Dim j As Long
Dim n As Integer
Dim y As Long
Dim tempVal As Integer




Set ws = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = Workbooks("Workbook2").Worksheets("Sheet1")


lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
lastCol = ws.Cells(ws2.Rows.Count, 1).End(xlUp).Row


For i = 3 To lastRow Step 1
   For y = 3 To lastRow Step 1
    For j = 3 To lastCol Step 1

    If ws.Cells(i, j) <> vbNullString Then
    tempVal = ws.Cells(i, j).Value
    ws2.Cells(y, 2) = ws.Cells(i, 2).Value
    ws2.Cells(y, 3) = tempVal
    ws2.Cells(y, "K") = ws.Cells(2, j).Value

    End If

    If tempVal <> 0 And tempVal - 1 Then
    y = y + 1
    End If

    If j = 41 Then
    i = i + 1
    End If

    tempVal = 0

    y = y

    Next j
    Next y
    Next i


End Sub

Answer 1

我利用Excel的Transpose功能，根据您显示的示例数据使代码正常工作：

print(UIScreen.mainScreen().availableModes)

Answer 2

看看这个宏，看看你对它的看法。我复制了您的样本集，并且能够使用嵌套for循环复制您想要的结果。如果有任何需要澄清，请告诉我。

Option Explicit

Sub customTransposing()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim startingRow As Integer
Dim startingColumn As Integer
Dim numberOfPoints As Integer
Dim numberOfEntries As Integer
Dim numberOfGroups As Integer
Dim outputRowOffset As Integer

' -------------------------------------------------------------------------------------------
' User Variables
' -------------------------------------------------------------------------------------------
startingRow = 3
startingColumn = 1
numberOfPoints = 4  ' The number of test points i.e. A B C D
numberOfEntries = 0
numberOfGroups = 3
outputRowOffset = 10
' -------------------------------------------------------------------------------------------


' Counts the number of entries in the first column
'   this section could most likely be improved
Cells(startingRow, startingColumn).Select

Do Until IsEmpty(ActiveCell)

    If Not IsEmpty(ActiveCell) Then

        numberOfEntries = numberOfEntries + 1

    End If

    ActiveCell.Offset(1, 0).Select

Loop



For j = 0 To numberOfEntries - 1

    For k = 0 To numberOfGroups - 1

        For i = 0 To numberOfPoints - 1

                ' first column
                Cells(startingRow + numberOfEntries + (j * numberOfPoints * numberOfGroups) + outputRowOffset + i + k * numberOfPoints, startingColumn).Value = Cells(startingRow + j, startingColumn)
                ' second column
                Cells(startingRow + numberOfEntries + (j * numberOfPoints * numberOfGroups) + outputRowOffset + i + k * numberOfPoints, startingColumn + 1).Value = Cells(startingRow + j, startingColumn + 2 + i + k * (numberOfGroups + 2))
                ' third column
                Cells(startingRow + numberOfEntries + (j * numberOfPoints * numberOfGroups) + outputRowOffset + i + k * numberOfPoints, startingColumn + 2).Value = Cells(startingRow - 1, startingColumn + 2 + i)
                ' fourth column
                Cells(startingRow + numberOfEntries + (j * numberOfPoints * numberOfGroups) + outputRowOffset + i + k * numberOfPoints, startingColumn + 3).Value = Cells(startingRow + j, startingColumn + 1 + k * (numberOfGroups + 2))

        Next i

    Next k

Next j

End Sub

循环遍历动态列和行并转置数据

2 个答案: