每2到3行处理一次 [英] Transpose every 2nd and 3rd line

问题描述

我正在尝试将第二行和第三行转置到列B和C，然后优选删除旧行，以便在B和C中没有两个未使用的行。我尝试记录一个仅适用于该行的宏我做的选择然后我尝试删除特定的选择并用偏移范围替换，但是我在PasteSpecial行中收到错误。

  Sub SortRawData（）
'
'SortRawData宏
'
'键盘快捷键：Ctrl + q 
'
 Selection.Offset（1，0）.Resize （Selection.Rows.Count + 2，_ 
 Selection.Columns.Count）。选择
 ActiveCell.Copy 
 ActiveCell.Offset（-1，1）。选择
 ActiveCell。 PasteSpecial Paste：= xlPasteValues，Transpose：= True 
 Application.CutCopyMode = False 
 Selection.Delete Shift：= xlUp 
 End Sub 
  

我最初尝试使用选择，我有ActiveCell，但似乎都没有工作。我知道我将数据转换到B和C列之后，我想删除两行的选择。我所拥有的格式为：

$的原始数据转储b $ b

项目1重量1颜色1项目2重量2颜色2项目3重量3颜色3

我可以让它一次转移一个选择我似乎不以便自动化。

  Sub SortRawData2（）
'
'SortRawData2宏
'
'键盘快捷键：Ctrl + w 
'
 Selection.Copy 
范围（B1）。选择
 Selection.PasteSpecial粘贴：= xlPasteAll，操作：= xlNone，SkipBlanks：= _ 
 False，Transpose：= True 
行（2：3）。选择
 Application.CutCopyMode = False 
 Selection.Delete Shift ：= xlUp 
 End Sub 
  

这是初始记录的宏，甚至调试失败Paste Special专线。任何建议将非常感谢！

谢谢！

解决方案

尝试这样，然后编写一个自动过滤器来删除空行：

  Sub SortRawData2（）
 Dim lLastRow As Long，lLoop As Long 
 
 lLastRow = Cells（Rows.Count，1）.End（xlUp）.Row 
 
对于lLoop = 1至lLastRow步骤3 
单元格（lLoop ，2）=单元格（lLoop + 1，1）
单元格（lLoop，3）=单元格（lLoop + 2,1）
单元格（lLoop + 1，1）.Resize（2）.ClearContents 
下一个lLoop 
 
带范围（A1：A& lLastRow）
 .AutoFilter字段：= 1，Criteria1：==
 .Offset 1）.SpecialCells（xlCellTypeVisible）.EntireRow.Delete 
 .AutoFilter 
结束
 
 
 End Sub 
  pre> 
I am trying to transpose every second and third row to columns B and C and then preferably delete the old rows so that I don't have two unused rows in B and C. I tried recording a macro, which worked for only the selection I made. Then I tried deleting the specific selections and replacing them with an offset range but I keep getting an error in the PasteSpecial line.
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
I tried initially using Selection everywhere I have ActiveCell but neither seemed to work. I know I am missing the selection for the two rows I want to delete after I transpose the data into column B and C. What I have is a raw data dump of information that is formatted as:

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

I can get it to transpose one selection at a time by I can't seem to square away the automation of it.
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
This is the initial recorded macro and even it fails debugging at the PasteSpecial line. Any suggestions would be much appreciated!

Thanks!
解决方案
Try this, then code an autofilter to remove the empty rows:
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


                        
这篇关于每2到3行处理一次的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！