通过插入和复制并粘贴特殊来sorting数据
我目前正在尝试整理数据。 这是给定的数据。 名单继续，123的数字会有所不同。
Header Header A 1 2 3 4 5 B 1 2 3 4 5 6 7 C 1 2 .... .... .... 理清后应该看什么
Header Header A 1 A 2 A 3 A 4 A 5 B 1 B 2 B 3 B 4 B 5 B 6 B 7 C 1 C 2
我已经尝试使用插入，复制和粘贴特殊的代码。 我正在尝试使用一个小数字来testing，但它似乎并没有与循环工作。 有没有人有任何build议，我怎么能做到这一点或什么可以改善？
s = 3 x = 0 w = 2 For d = 0 To 1 Step 1 y = 3 x = 0 Do Until IsEmpty(Sheet1.Cells(w, y).Value) y = y + 1 x = x + 1 Loop Rows(s & ":" & v + 2).Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove z = x + 2 Set ran = Sheet1.Range(Sheet1.Cells(w, s), Sheet1.Cells(w, z)) ran.Copy Sheet1.Range(Sheet1.Cells(s, w), Sheet1.Cells(s, w)).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ran.Clear w = w + v + 1 s = s + v Next d
花了那么多时间，但我们走了，
Sub mertinc() Dim mert, inc As Long Application.ScreenUpdating = False Range("a1048576").Select mert = Selection.End(xlUp).Row Dim mertindex As Integer mertindex = 1 Do While mertindex <= mert Range("a" & mertindex).Activate inc = Range(Selection.Offset(0, 1), Selection.End(xlToRight)).Count Range(Selection.Offset(0, 1), Selection.End(xlToRight)).Copy Range("XX1048576").Select Selection.End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True Range("XW1048576").Select Selection.End(xlUp).Offset(1, 0).Resize(inc, 1).Select Selection.Value = Range("a" & mertindex).Value mertindex = mertindex + 1 Loop Application.ScreenUpdating = True End Sub
在这个例子中，你可以得到你想要的XW和XX列。 您可以创build另一个页面来创build此列表，或者您可以清除以前的列表并复制新的列表，而不是它们。 现在就由你决定了。
如果您不了解代码的任何部分，请告诉我。
这只是看看我们如何才能改进Mertinc的代码 ，并通过一些小的改进来遵循最佳实践。
这明显不是指责任何人，而是善于学习的目的，看到不同之处。
Option Explicit Sub TransformData() Dim lastRowScr As Long, lastRowDest As Long Dim numCols As Long Dim wsSrc As Worksheet, wsDest As Worksheet Set wsSrc = ThisWorkbook.Worksheets("Sheet1") '* worksheet with source data Set wsDest = ThisWorkbook.Worksheets("Sheet2") '* another worksheet to paste data Application.ScreenUpdating = False lastRowScr = wsSrc.Range("A" & wsSrc.Rows.Count).End(xlUp).Row '* determine last row in column A Dim iRow As Long iRow = 1 Do While iRow <= lastRowScr With wsSrc.Range(wsSrc.Range("B" & iRow), wsSrc.Range("A" & iRow).End(xlToRight)) numCols = .Count .Copy End With With wsDest lastRowDest = .Range("B" & .Rows.Count).End(xlUp).Row If IsEmpty(.Range("B" & lastRowDest)) Then lastRowDest = lastRowDest - 1 '* make sure that we start in row 1 .Range("B" & lastRowDest + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True .Range("A" & lastRowDest + 1).Resize(numCols, 1).Value = wsSrc.Range("A" & iRow).Value End With iRow = iRow + 1 Loop Application.ScreenUpdating = True End Sub
此过程使用sheet1作为数据源并将转换的数据插入到sheet2 。
说明
在这里，我试图解释这些差异，并展示一些更多的文献。
1.始终使用描述性variables和程序/function命名
使用您的用户名命名程序和variables
Sub mertinc() Dim mert, inc As Long
是不好的做法，而应该使用描述性的名字
Sub TransformData() Dim lastRowScr As Long, lastRowDest As Long Dim numCols As Long
也需要用一个types来指定每个variables。 Dim mert, inc As Long将把mert作为变体，只声明inc长。
对自己和其他人的可读性要好得多，因此可能在代码中的问题更less。
2.总是用长而不是整数
永远不要使用整数，除非需要与一个需要16位int的旧API调用进行交互。 使用整数代替long是没有好处的 。
3.避免使用select或激活
而不是使用.Select或.Activate
Range("a1048576").Select lastRowScr = Selection.End(xlUp).Row
使用直接访问
lastRowScr = Range("a1048576").End(xlUp).Row
代码更快，更短。
也永远不要假设工作表
始终使用完全合格的范围
Set ws = ThisWorkbook.Worksheets("Sheet1") lastRowScr = ws.Range("a1048576").End(xlUp).Row
较less的问题。 如果select了另一个工作表，此代码仍然有效。
5.永远不要使用固定的行数
而不是固定的行数
lastRowScr = ws.Range("a1048576").End(xlUp).Row
总是检测最后一行
lastRowScr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
不同的Excel版本有不同的最大值。 行数。 因此，此代码独立运行版本。