时间戳

首页 > 解决方案 > 获取垂直列出的数据并创建多个水平行

excel - 获取垂直列出的数据并创建多个水平行

问题描述

我将客户数据调整并水平放置在 Excel 中。我想使用 VBA 来做到这一点。

我希望每次都将这些数据放在下一个可用行上。

还有一种方法可以自动选择要移动的九个单元格。我为其中的一大块数据创建了一个宏，但无法进一步移动。

当前代码：

Sub Test()
'
' Test Macro
'

'
    ActiveCell.Offset(-11, -4).Range("A1:A9").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveCell.Offset(0, 13).Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "US"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Company Order"
    ActiveCell.Offset(0, -8).Range("A1").Select
    ActiveCell.FormulaR1C1 = "1 (407) 5556032"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = " johndoe@aol.com"
    ActiveCell.Offset(2, 0).Range("A1").Select
End Sub

起始垂直列表

期望的结果

标签： excelvbaloops

解决方案

请尝试以下操作，只需调整您的报告工作簿工作表变量（在代码中标记）。另外我在最后添加了一个功能，询问是否要删除垂直数据，请先测试用多个报告集回复“NO”，以便测试子不丢失任何数据。

Option Explicit
Sub formatReport()
    
    'the grouping data size variable (in this case 9 rows per group)
    Dim groupSize As Integer: groupSize = 9
    
    'report data worksheet variable
    Dim wsh As Worksheet: Set wsh = ThisWorkbook.Sheets(1) '--adjust to your report worksheet here
    
    'Insert a blank row in position 2 (new data will always be inserted in row2)
    wsh.Range("A2").EntireRow.Insert xlShiftDown
    
    'variable to count group of data added
    Dim dataGroupAddedCount As Long: dataGroupAddedCount = 0
    
    Dim lastRow As Long: lastRow = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
    Dim i As Long: i = 3
    'Loop data
    Do While i <= lastRow
        If wsh.Cells(i, 1).Value = "" Then GoTo EvaluateNext
        Dim j As Long
        'first column were data will be inserted ("recipient" column)
        Dim firstColumn As Integer: firstColumn = 2
        For j = 0 To groupSize - 1
            wsh.Cells(2, firstColumn).Value = wsh.Cells(j + i, 1).Value
            firstColumn = firstColumn + 1
        Next j
        wsh.Range("A2").EntireRow.Insert xlShiftDown
        lastRow = lastRow + 1
        i = i + groupSize
        dataGroupAddedCount = dataGroupAddedCount + 1
EvaluateNext:
        i = i + 1
    Loop
    
    'If there was no data, exit
    wsh.Range("A2").EntireRow.Delete
    If dataGroupAddedCount = 0 Then MsgBox "Process completed, NO DATA found.", vbInformation, "Process completed": Exit Sub
    
    'Prompt if want to delete the vertical data
    Dim Ans As String
    Ans = MsgBox("Process completed, " & dataGroupAddedCount & " rows of data were added horizontally." & _
    vbCr & "Do you want to delete the vertical-formated data?", vbQuestion + vbYesNo, "Process completed")
    
    If Ans = vbYes Then wsh.Range("A" & dataGroupAddedCount + 2 & ":A" & lastRow).ClearContents

End Sub

推荐阅读