如何优化这个宏？
如何优化这个宏？
提问于 2020-08-14 13:36:44
我有一个投资组合报告，我构建从VBA代码每月和临时的基础上。现在它运行得很好，但是底层的VBA还远远没有优化。下面的代码片段被重复了5次，因为现在系统中有5个项目，但是很快就会增加到50个。是否有人建议我如何更优雅地使用VBA来执行对代码中指定位置的复制(请参阅下面的代码段)
Sub CreatePortFolio()
Application.ScreenUpdating = False
'Clears old data
Application.Goto Reference:="PFData" 'Named range in the portfolio overview sheet
Selection.ClearContents
'************* Project 1
If Not Sheets(Sheets.Count).Range("BG1").Value = "" Then
Ark4.Range("B5").Value = Sheets(Sheets.Count).Range("BG1").Value 'Ark4 is the portfolio report and the sheets.count is used to pick the latest import of data - always in the same format
Ark4.Range("C5").Value = Sheets(Sheets.Count).Range("BF1").Value
Ark4.Range("D5").Value = Sheets(Sheets.Count).Range("BH1").Value
Ark4.Range("E5").Value = Sheets(Sheets.Count).Range("AU1").Value
Ark4.Range("F5").Value = Sheets(Sheets.Count).Range("AU2").Value
Ark4.Range("G5").Value = Sheets(Sheets.Count).Range("AU3").Value
Ark4.Range("H5").Value = Sheets(Sheets.Count).Range("AV1").Value
Ark4.Range("I5").Value = Sheets(Sheets.Count).Range("AV2").Value
Ark4.Range("J5").Value = Sheets(Sheets.Count).Range("AV3").Value
Ark4.Range("L4").Value = Sheets(Sheets.Count).Range("AP3").Value
Ark4.Range("L5").Value = Sheets(Sheets.Count).Range("AP4").Value
Ark4.Range("L6").Value = Sheets(Sheets.Count).Range("AP5").Value
Ark4.Range("M4").Value = Sheets(Sheets.Count).Range("AQ3").Value
Ark4.Range("M5").Value = Sheets(Sheets.Count).Range("AQ4").Value
Ark4.Range("M6").Value = Sheets(Sheets.Count).Range("AQ5").Value
Ark4.Range("N4").Value = Sheets(Sheets.Count).Range("AR3").Value
Ark4.Range("N5").Value = Sheets(Sheets.Count).Range("AR4").Value
Ark4.Range("N6").Value = Sheets(Sheets.Count).Range("AR5").Value
Ark4.Range("O4").Value = Sheets(Sheets.Count).Range("AS3").Value
Ark4.Range("O5").Value = Sheets(Sheets.Count).Range("AS4").Value
Ark4.Range("O6").Value = Sheets(Sheets.Count).Range("AS5").Value
Ark4.Range("Q4").Value = Sheets(Sheets.Count).Range("AP10").Value
Ark4.Range("Q5").Value = Sheets(Sheets.Count).Range("AP11").Value
Ark4.Range("Q6").Value = Sheets(Sheets.Count).Range("AP12").Value
Ark4.Range("R4").Value = Sheets(Sheets.Count).Range("AQ10").Value
Ark4.Range("R5").Value = Sheets(Sheets.Count).Range("AQ11").Value
Ark4.Range("R6").Value = Sheets(Sheets.Count).Range("AQ12").Value
Ark4.Range("S4").Value = Sheets(Sheets.Count).Range("AR10").Value
Ark4.Range("S5").Value = Sheets(Sheets.Count).Range("AR11").Value
Ark4.Range("S6").Value = Sheets(Sheets.Count).Range("AR12").Value
Ark4.Range("T4").Value = Sheets(Sheets.Count).Range("AS10").Value
Ark4.Range("T5").Value = Sheets(Sheets.Count).Range("AS11").Value
Ark4.Range("T6").Value = Sheets(Sheets.Count).Range("AS12").Value
Ark4.Range("U5").Value = Sheets(Sheets.Count).Range("AW4").Value
Ark4.Range("V5").Value = Sheets(Sheets.Count).Range("AW3").Value
End If
'******* I Want to avoid copying the above code 50 times *******
Application.ScreenUpdating = True
End Sub投资组合报告如下所示：
构建报表的数据表如下所示：
回答 1
Stack Overflow用户
回答已采纳
发布于 2020-08-14 16:21:38
试试看
Sub test()
Dim wsData As Worksheet
Dim Ws As Worksheet
Dim vDB As Variant
Dim vR() As Variant
Dim Ark4 As Worksheet
Dim i As Long, n As Long, r As Long
Set Ark4 = Sheets(1) ' set your sheets
Set wsData = Sheets(Sheets.Count)
With wsData
r = .Range("BG" & Rows.Count).End(xlUp).Row + 11
vDB = .Range("ap1", "bh" & r)
End With
For i = 1 To r Step 12
If vDB(i, 18) <> "" Then
n = n + 3
ReDim Preserve vR(1 To 21, 1 To n)
'Column b ~ j
vR(1, n - 2) = vDB(i, 18) 'bg1
vR(2, n - 2) = vDB(i, 17) 'bf1
vR(3, n - 2) = vDB(i, 19)
vR(4, n - 2) = vDB(i, 6)
vR(5, n - 2) = vDB(i + 1, 6)
vR(6, n - 2) = vDB(i + 2, 6)
vR(7, n - 2) = vDB(i, 7)
vR(8, n - 2) = vDB(i + 1, 7)
vR(9, n - 2) = vDB(i + 2, 7)
'Column k ~ o
vR(10, n - 2) = "Budget"
vR(10, n - 1) = "Installemnt"
vR(10, n) = "Deviation"
vR(11, n - 2) = vDB(i + 2, 1) 'ap3
vR(11, n - 1) = vDB(i + 3, 1) 'ap4
vR(11, n) = vDB(i + 4, 1) 'ap5
vR(12, n - 2) = vDB(i + 2, 2) 'aq3
vR(12, n - 1) = vDB(i + 3, 2) 'aq4
vR(12, n) = vDB(i + 4, 2) 'aq5
vR(13, n - 2) = vDB(i + 2, 3) 'ar3
vR(13, n - 1) = vDB(i + 3, 3) 'ar4
vR(13, n) = vDB(i + 4, 3) 'ar5
vR(14, n - 2) = vDB(i + 2, 4) 'as3
vR(14, n - 1) = vDB(i + 3, 4) 'as4
vR(14, n) = vDB(i + 4, 4) 'as5
'Column p ~ z
vR(15, n - 2) = "Budget"
vR(15, n - 1) = "Installemnt"
vR(15, n) = "Deviation"
vR(16, n - 2) = vDB(i + 9, 1) 'ap10
vR(16, n - 1) = vDB(i + 10, 1) 'ap11
vR(16, n) = vDB(i + 11, 1) 'ap12
vR(17, n - 2) = vDB(i + 9, 2) 'aq10
vR(17, n - 1) = vDB(i + 10, 2) 'aq11
vR(17, n) = vDB(i + 11, 2) 'aq12
vR(18, n - 2) = vDB(i + 9, 3) 'ar10
vR(18, n - 1) = vDB(i + 10, 3) 'ar11
vR(18, n) = vDB(i + 11, 3) 'ar12
vR(19, n - 2) = vDB(i + 9, 4) 'as10
vR(19, n - 1) = vDB(i + 10, 4) 'as11
vR(19, n) = vDB(i + 11, 4) 'as12
'Column u,v
vR(20, n - 2) = vDB(i + 3, 8) 'aw4
vR(21, n - 2) = vDB(i + 2, 8) 'aw3
End If
Next i
With Ark4
.Range("b4").Resize(n, 21) = WorksheetFunction.Transpose(vR)
End With
End Sub假设数据表中的数据重复使用，如下图所示。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/63413845
复制相关文章
相似问题
腾讯云开发者
