如何调整代码以获得更好的性能
如何调整代码以获得更好的性能
提问于 2013-01-23 21:52:21
我正在尝试从excel文件中制作边缘关系，这些文件是按行组织的，
A，B，C，
D，E
目标是从每一行创建关系：
A、B
A、C
B、C
我有以下代码，问题是当行的长度相等时，代码是有效的，但例如，对于上面的行，它还创建了以下边(关系)：
D，“”
E，“”
这给大数据集带来了很大的问题。我想知道是否有人可以帮助我调整代码，以创建边缘列表的方式，直到每行填充单元格。如果有其他更有效的方法，我将不胜感激。
太感谢你了，会对你有很大帮助的。
我的代码：
Sub Transform()
Dim targetRowNumber As Long
targetRowNumber = Selection.Rows(Selection.Rows.Count).Row + 2
Dim col1 As Variant
Dim cell As Range
Dim colCounter As Long
Dim colCounter2 As Long
Dim sourceRow As Range: For Each sourceRow In Selection.Rows
For colCounter = 1 To Selection.Columns.Count - 1
col1 = sourceRow.Cells(colCounter).Value
For colCounter2 = colCounter + 1 To Selection.Columns.Count
Set cell = sourceRow.Cells(, colCounter2)
If Not cell.Column = Selection.Column Then
Selection.Worksheet.Cells(targetRowNumber, 1) = col1
Selection.Worksheet.Cells(targetRowNumber, 2) = cell.Value
targetRowNumber = targetRowNumber + 1
End If
Next colCounter2
Next colCounter
Next sourceRow
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2013-01-25 09:56:02
我已经玩过了--这个应该能行得通。如果需要，我们可以通过输出到另一个变量数组来加快速度，但这对我来说运行得相当快：
Sub Transform_New()
Dim rngSource As Range, rngDest As Range
Dim varArray As Variant
Dim i As Integer, j As Integer, k As Integer
Set rngSource = Sheet1.Range("A1", Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1)) 'Put all used rows into range
Set rngDest = Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1).Offset(2, 0) 'Set target range to start 2 below source range
varArray = Range(rngSource, rngSource.Offset(0, Range("A1").SpecialCells(xlCellTypeLastCell).Column)).Value
For i = LBound(varArray, 1) To UBound(varArray, 1) 'Loop vertically through array
For j = LBound(varArray, 2) To UBound(varArray, 2) 'Loop horizontally through each line apart from last cell
k = j
Do Until varArray(i, k) = ""
k = k + 1
If varArray(i, k) <> "" Then
rngDest.Value = varArray(i, j)
rngDest.Offset(0, 1).Value = varArray(i, k)
Set rngDest = rngDest.Offset(1, 0)
End If
Loop
Next
Next
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/14490095
复制相关文章
点击加载更多
相似问题
使用cobertura的声纳插件配置
定制maven校验式插件
cobertura插件与FindBugs的冲突
在声纳校验式插件中使用@SuppressWarnings
Maven FindBugs插件
添加站长 进交流群
领取专属 10元无门槛券
AI混元助手 在线答疑
关注 腾讯云开发者公众号
洞察 腾讯核心技术
剖析业界实践案例
腾讯云开发者
