当前位置: 首页> 财经> 创投人物 > Microsoft VBA Excel VBA函数学习笔记——数据切分熟练度+1

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

时间:2025/7/10 2:47:27来源:https://blog.csdn.net/RandPython/article/details/141127927 浏览次数:0次

问题场景

123456
Stock006006006002002002
MarketUSUSUSUSUSUS
Weight0.010.1090.2280.2220.2390.72
CurrencyEURUSDCNYEURUSDCNY
Term10.0740.0820.0120.0470.0580.067
Term20.040.020.010.070.0580.067
Term30.0540.0520.0140.0870.0480.017
Term40.0710.0840.0020.0170.0180.097

函数接收六个参数,包括工作簿地址和sheet名称等。函数将会根据指定的StockMarket来筛选数据,并将特定的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

缺陷:

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

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

草稿版本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. 动态处理:函数现在可以动态地处理不同的StockMarket组合,并且可以适应Currency列位置的变化。

总结

仍存在缺陷,稍后会更新

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

版权声明:

本网仅为发布的内容提供存储空间,不对发表、转载的内容提供任何形式的保证。凡本网注明“来源:XXX网络”的作品,均转载自其它媒体,著作权归作者所有,商业转载请联系作者获得授权,非商业转载请注明出处。

我们尊重并感谢每一位作者,均已注明文章来源和作者。如因作品内容、版权或其它问题,请及时与我们联系,联系邮箱:809451989@qq.com,投稿邮箱:809451989@qq.com

责任编辑: