vb.net - excel 2007的另一个优化宏vba代码。该代码是我数据的一种转置器

Question

您好，此代码最初不是由我完成的，这里有一些我不太明白的问题，我已经从我的同事代码中对其进行了一些更改以适应我的数据并且它可以工作。但太慢了。当我有 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

Jon 提出了一个很好的建议 g >.> 我应该坚决提供一些东西来向你们展示这段代码是关于什么的。图 1 是文件转置前的样子





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

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

Answer 1

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

您应该遵循的步骤:

计算出源数据范围，并设置 Range变数
Dim rngData as RangeSet rngData = Your Source Range

复制数据
Dim varSource as VariantvarSource = rngData

计算目标数据的大小并将变体数组调暗到该大小
Dim varDestn() as variantRedim varDestn(1 to NumberOfRows, 1 to NumberOfColumns)

计算新数据。将值从 varDource(row,col) 复制到 varDestn(row,col)

删除原始数据(如果需要)

将新数据放在工作表上
Set rngData = Cells(1,1) _ .Resize(UBound(varDestn,1), UBound(varDestn,2)) _ .Offset(TopLeftCellRow, TopLeftCellCol)rngData = varDestn

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