Excelmacros：将数据从一行排列到另一列

我有一个只有一列的Excel文件。 我想从前4行的内容移动到四个不同的列（第一列第一行，第二列第二列等），然后我想重复同样的操作，直到列的所有值已经分配给这四列（四列重复一系列）。 然后，每一行都有一个独特的词，我想要find并基于此我想将其移动（剪切和粘贴）到一个特定的列。 我觉得下面的例子更容易解释。 我想find“奶酪”一词，如果发现我想把它移到第二列，并重复这个操作，直到所有包含“奶酪”这个词的行都排列成一列。 我正在试图将数据安排到一个表格中，稍后我会进一步使用。 谢谢您的帮助。 我从.txt文件获取数据并将其放入Excel中也certificate有点困难。

例

Row1 Cheese: 250 Row2 Ham: 35 Row3 Cheese: 200 Row 4 Ham:40 Row5 Cheese: 230 Row6 Ham:45 

码

 Sub test4() Dim lastrow As Long lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row For i = 1 To lastrow Range("A1").Activate Cells.Find(What:="Part").Copy If ActiveSheet.Cells(i, 2) = "" Then ActiveSheet.Cells(i, 2).Activate 'Range("B1").Activate ActiveCell.PasteSpecial (xlPasteAll) End If Next i End Sub 

Answer 1

这将复制从C1开始的数据

 Sub test4() Const PER_ROW As Long = 4 Dim i As Long, sht as WorkSheet Set sht = ActiveSheet For i = 1 To sht.UsedRange.SpecialCells(xlCellTypeLastCell).Row sht.Cells(1,3).offset(Application.Floor((i-1)/PER_ROW, 1) , _ (i-1) Mod PER_ROW).value = sht.Cells(i,1).Value Next i End Sub 

Answer 2

 Sub MoveData() Dim x As Long Application.ScreenUpdating = False For x = 1 To Range("A" & Rows.Count).End(xlUp).Row Range("B1:E1").Cells(x).Value = Cells(x, 1).Value Next Columns(1).Delete Columns.AutoFit Application.ScreenUpdating = True End Sub