Question

我已经为我的代理人完成了调查，系统为我提供了XML格式的报告。当我将相同的内容更改为Excel时，我会以下面提到的格式进行调查

Survey number
Agent Name
Rating 1
Rating 2
Rating 3 
Rating 4 
Rating 5
Comments

使用这种格式我每天大约有700次调查，我需要将其转换为下面提到的格式

Survey number/Agent Name/Rating 1/Rating 2/Rating 3/Rating 4/Rating 5/Comments

问题是宏继续打开，文件变得很重。

任何人都可以帮助了解宏如何检测下一个调查并自动从一张纸上复制数据，然后在下一张纸上转置它，以便落在前一行的正下方。我对VB没有太多的了解。

Answer 1

以下来源应该做你想要的。

它使用第一张纸作为源，第二张纸作为目标。

首先搜索工作表2第一列中的第一个空单元格。

然后遍历工作表1中的所有行并复制数据，直到找到一个空的测量编号。原始数据不会被删除，取消注释一行以实现这一点（参见来源）。

Sub transpose()
    Dim sourceRow, targetRow, targetColumn As Integer

    ' find first empty row in target sheet
    targetRow = 1
    While (Sheets(2).Cells(targetRow, 1) <> "")
        targetRow = targetRow + 1
    Wend

    sourceRow = 1
    While (Sheets(1).Cells(sourceRow, 1) <> "")
        For targetColumn = 1 To 8
            ' copy
            Sheets(2).Cells(targetRow, targetColumn) = Sheets(1).Cells(sourceRow, 1)
            ' delete original row (uncomment if required)
            ' Sheets(1).Cells(sourceRow, 1) = ""
            sourceRow = sourceRow + 1
        Next targetColumn
        targetRow = targetRow + 1
    Wend
End Sub

Answer 2

这是另一种只有一个循环的方式

Public Sub TransposeData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    With Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To LastRow Step 8

            .Cells(i, "A").Resize(8).Copy
            NextRow = NextRow + 1
            .Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, transpose:=True
        Next i

        .Rows(NextRow + 1).Resize(LastRow - NextRow).Delete
        .Columns(1).Delete
    End With

    Application.ScreenUpdating = True
End Sub

宏在新工作表中复制和转置每第七行和过去

2 个答案: