另一个针对 excel 2007 的优化宏 vba 代码。该代码是我的数据的一种转置器

您好，这段代码最初不是由我完成的，这里有一些事情我不太明白，我已经对我的同事代码进行了一些修改以适应我的数据并且它有效。但太慢了。当我有 4000+kb 的 Excel 文件时，它可能会完全冻结。 （我已经检查过，当这个转置器运行时和之后，它仍然在 excel 行限制内，我之前已经完成了计算，并制作了一个宏来根据列数和行数自动分割 excel 文件，以确保情况如此） 。这段代码似乎开始时很快，然后运行时间越长，速度就越慢。至少在我看来是这样的。

请随意提出任何使此代码更快/更好的方法！感谢您的时间。 抱歉，我不太理解这段代码。

我已经关闭了屏幕更新、自动计算等。

Dim InitRange As Range
Dim Counter As Range
Dim paracount As Long
Dim Filler As Range
Dim ParaSelect As Range
Dim Paraloc As Range
Dim Paravalloc As Range
Dim Unitloc As Range
Dim methodloc As Range
Dim CurNum As Long
Dim MaxNum As Long
Dim eCell As Range
Dim checkRow As Long
Dim InsertRow As Long
Dim x As Long
Dim y As Long
Dim vRow As Long

CurNum = 0
MaxNum = 0

x = 1

Range("K1").End(xlToRight).Offset(0, 0).Select

Set ParaSelect = Range("K1", ActiveCell)
InsertRow = ParaSelect.Count - 1

Set InitRange = Range("A4", "F4")
Set Counter = InitRange

Do
MaxNum = MaxNum + 1
InitRange.Offset(MaxNum, 0).Activate
Loop Until ActiveCell = ""


Set eCell = InitRange.Offset(0, 0)

Do
eCell.Offset(x, 0).Activate
Rows(eCell.Offset(x, 0).row & ":" & eCell.Offset(x, 0).row + InsertRow - 1).Insert
x = x + InsertRow + 1
If x > MaxNum * (InsertRow + 1) Then Exit Do
Loop

Range("A1").Activate

Set Filler = InitRange

Set Paraloc = Range("G4")
Set Paravalloc = Range("H4")
Set Unitloc = Range("I4")
Set methodloc = Range("J4")

vRow = 0
y = 0
Do

ParaSelect.Copy
Paraloc.Offset(y, 0).PasteSpecial xlPasteValues, Transpose:=True

ParaSelect.Offset(1, 0).Copy
methodloc.Offset(y, 0).PasteSpecial xlPasteValues, Transpose:=True

ParaSelect.Offset(2, 0).Copy
Unitloc.Offset(y, 0).PasteSpecial xlPasteValues, Transpose:=True

ParaSelect.Offset(CurNum * (InsertRow + 1) + 3, 0).Copy
Paravalloc.Offset(y, 0).PasteSpecial xlPasteValues, Transpose:=True

Filler.Offset(y, 0).Copy
CurNum = CurNum + 1
y = y + 1
checkRow = 1
Do
Filler.Offset(y, 0).PasteSpecial xlPasteValues
y = y + 1
Filler.Offset(y, 0).Activate
checkRow = checkRow + 1

Loop Until checkRow > InsertRow
Loop Until CurNum >= MaxNum

乔恩提出了一个很好的建议>.> 我应该坚决地提供一些东西来向你们展示这段代码的含义。图1是文件转置前的样子

图2是文件转置后的样子。不用担心 k 列及之后的列将被删除。

注意：文件可以有任意数量的列和行

此代码缓慢的主要原因是循环中的所有单元格引用。如果将数据复制到变体数组并对其进行处理，它的运行速度会快得多。

您应该遵循的步骤：

1. 计算出源数据范围，并设置Range变量

   Dim rngData as Range
Set rngData = Your Source Range

2. 复制数据

   Dim varSource as Variant
varSource = rngData

3. 计算目标数据的大小并将变体数组调暗为该大小

   Dim varDestn() as variant
Redim varDestn(1 to NumberOfRows, 1 to NumberOfColumns)

4. 计算新数据。复制值来自varSource(row,col) to varDestn(row,col)

5. 删除原始数据（如果需要）

6. 将新数据放在工作表上

   Set rngData = Cells(1,1) _
.Resize(UBound(varDestn,1), UBound(varDestn,2)) _
.Offset(TopLeftCellRow, TopLeftCellCol)
rngData = varDestn

一般来说，将对工作表的引用数量保持在最低限度，尤其是在循环中