Microsoft VBA Excel VBA函数学习笔记——数据切分熟练度+1

问题场景

函数接收六个参数，包括工作簿地址和sheet名称等。函数将会根据指定的Stock和Market来筛选数据，并将特定的Currency数据复制到目标工作簿的相应位置。同时，会把对应的Weight值存储到另一个目标sheet中。

草稿版本1:

Function UpdateRatesAndWeights(sourceWorkbookPath As String, sourceSheetName As String, _ByVal wsTarget As Worksheet, ByVal wsRun As Worksheet, _selectedStock As String, selectedMarket As String)Dim wbSource As WorkbookDim wsSource As WorksheetDim lastRow As Long, lastColumn As LongDim r As Long, c As LongDim startRow As Long, endRow As Long, startColumn As Long, endColumn As LongDim currencyColumn As IntegerDim weightRange As Range, termRange As RangeDim targetRow As LongDim currencyCode As StringDim weightName As String' 打开源工作簿Set wbSource = Workbooks.Open(sourceWorkbookPath)Set wsSource = wbSource.Sheets(sourceSheetName)' 获取数据的总行数和列数lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).RowlastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column' 找到符合条件的数据行列范围For c = 1 To lastColumnIf wsSource.Cells(1, c).Value = selectedStock And wsSource.Cells(2, c).Value = selectedMarket ThenIf startColumn = 0 ThenstartColumn = cEnd IfendColumn = cEnd IfNext c' 设置Term行的起止startRow = 4  ' 假设Term数据从第4行开始endRow = 102  ' 假设Term数据到第102行 (共99个Term)' 逐一复制Currency对应的数据For c = startColumn To endColumncurrencyCode = wsSource.Cells(3, c).Value  ' Currency数据在第3行targetRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1' 复制数据到指定的Currency区域Set termRange = wsSource.Range(wsSource.Cells(startRow, c), wsSource.Cells(endRow, c))termRange.Copy Destination:=wsTarget.Cells(targetRow, wsTarget.Range(currencyCode).Column)' 复制Weight值weightName = "weight_" & currencyCodewsRun.Range(weightName).Value = wsSource.Cells(3, c).Offset(1, 0).Value  ' 假设Weight在Currency下面一行Next c' 关闭源工作簿wbSource.Close SaveChanges:=False
End Function

缺陷：

• 函数假设Currency和Weight数据的位置是固定的。如果位置有所不同，需要调整代码中的相关部分。
• 确保目标工作簿中有准确命名的命名区域，如EUR、USD、CNY以及weight_EUR等。
• 缺少错误处理、异常捕捉和更复杂的数据验证。

为了提高代码的精确性和通用性，我
可以加入一些功能，比如动态查找Currency和Weight的列位置，以及更加详细的错误处理。这样的改进可以让函数更加健壮，也能适应更多变的数据布局。

草稿版本2：

Function UpdateRatesAndWeights(sourceWorkbookPath As String, sourceSheetName As String, _ByVal wsTarget As Worksheet, ByVal wsRun As Worksheet, _selectedStock As String, selectedMarket As String)Dim wbSource As WorkbookDim wsSource As WorksheetDim lastRow As Long, lastColumn As LongDim r As Long, c As LongDim startRow As Long, endRow As Long, startColumn As Long, endColumn As LongDim currencyColumn As IntegerDim weightRange As Range, termRange As RangeDim targetRow As LongDim currencyCode As StringDim weightName As StringDim currencyColumnMap As Object' 使用字典来映射Currency与列号Set currencyColumnMap = CreateObject("Scripting.Dictionary")' 打开源工作簿Set wbSource = Workbooks.Open(sourceWorkbookPath)Set wsSource = wbSource.Sheets(sourceSheetName)' 获取数据的总行数和列数lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).RowlastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column' 找到符合条件的数据行列范围For c = 1 To lastColumnIf wsSource.Cells(1, c).Value = selectedStock And wsSource.Cells(2, c).Value = selectedMarket ThencurrencyCode = wsSource.Cells(3, c).ValuecurrencyColumnMap(currencyCode) = cEnd IfNext c' 设置Term行的起止startRow = 4  ' 假设Term数据从第4行开始endRow = 102  ' 假设Term数据到第102行 (共99个Term)' 逐一复制Currency对应的数据For Each currencyCode In currencyColumnMap.Keysc = currencyColumnMap(currencyCode)targetRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1' 复制数据到指定的Currency区域Set termRange = wsSource.Range(wsSource.Cells(startRow, c), wsSource.Cells(endRow, c))termRange.Copy Destination:=wsTarget.Cells(targetRow, wsTarget.Range(currencyCode).Column)' 复制Weight值weightName = "weight_" & currencyCodewsRun.Range(weightName).Value = wsSource.Cells(3, c).Offset(1, 0).Value  ' 假设Weight在Currency下面一行Next currencyCode' 关闭源工作簿wbSource.Close SaveChanges:=False
End Function

改进点说明：

1. 使用字典：使用字典（Scripting.Dictionary）来存储每种Currency及其对应的列号。这样可以更灵活地处理不同Currency的位置，而不是硬编码列号。

2. 动态处理：函数现在可以动态地处理不同的Stock和Market组合，并且可以适应Currency列位置的变化。

总结

仍存在缺陷，稍后会更新