每隔2行和3行进行转置

时间:2015-12-08 21:22:24

标签: excel vba excel-vba

我试图将每个第二和第三行转置到列B和C,然后最好删除旧行,这样我在B和C中没有两个未使用的行。我尝试录制一个宏,仅用于我做的选择。然后我尝试删除特定的选择并用偏移范围替换它们,但我在PasteSpecial行中不断收到错误。

Sub SortRawData()
'
' SortRawData Macro
'
' Keyboard Shortcut: Ctrl+q
'
    Selection.Offset(1, 0).Resize(Selection.Rows.Count + 2, _
        Selection.Columns.Count).Select
    ActiveCell.Copy
    ActiveCell.Offset(-1, 1).Select
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

我最初尝试使用Selection我到处都有ActiveCell,但似乎都没有用。我知道在将数据转换为B列和C列之后,我想要删除我要删除的两行的选择。我所拥有的是信息的原始数据转储,其格式为:

Item1 Weight1 Color1 Item2 Weight2 Color2 Item 3 Weight 3 Color 3

我可以让它一次转换一个选择,我似乎无法摆脱它的自动化。

Sub SortRawData2()
'
' SortRawData2 Macro
'
' Keyboard Shortcut: Ctrl+w
'
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("2:3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

这是初始录制的宏,甚至在PasteSpecial行调试失败。任何建议将不胜感激!

谢谢!

1 个答案:

答案 0 :(得分:0)

尝试此操作,然后编写自动过滤器以删除空行:

Sub SortRawData2()
Dim lLastRow As Long, lLoop As Long

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lLoop = 1 To lLastRow Step 3
    Cells(lLoop, 2) = Cells(lLoop + 1, 1)
    Cells(lLoop, 3) = Cells(lLoop + 2, 1)
    Cells(lLoop + 1, 1).Resize(2).ClearContents
Next lLoop

With Range("A1:A" & lLastRow)
    .AutoFilter field:=1, Criteria1:="="
    .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
End With


End Sub