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

问题场景

	1	2	3	4	5	6
Stock	006	006	006	002	002	002
Market	US	US	US	US	US	US
Weight	0.01	0.109	0.228	0.222	0.239	0.72
Currency	EUR	USD	CNY	EUR	USD	CNY
Term1	0.074	0.082	0.012	0.047	0.058	0.067
Term2	0.04	0.02	0.01	0.07	0.058	0.067
Term3	0.054	0.052	0.014	0.087	0.048	0.017
Term4	0.071	0.084	0.002	0.017	0.018	0.097
…	…	…	…	…	…	…

---

函数接收六个参数，包括工作簿地址和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 Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long, lastColumn As Long
    Dim r As Long, c As Long
    Dim startRow As Long, endRow As Long, startColumn As Long, endColumn As Long
    Dim currencyColumn As Integer
    Dim weightRange As Range, termRange As Range
    Dim targetRow As Long
    Dim currencyCode As String
    Dim weightName As String
    
    ' 打开源工作簿
    Set wbSource = Workbooks.Open(sourceWorkbookPath)
    Set wsSource = wbSource.Sheets(sourceSheetName)
    
    ' 获取数据的总行数和列数
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    lastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 找到符合条件的数据行列范围
    For c = 1 To lastColumn
        If wsSource.Cells(1, c).Value = selectedStock And wsSource.Cells(2, c).Value = selectedMarket Then
            If startColumn = 0 Then
                startColumn = c
            End If
            endColumn = c
        End If
    Next c
    
    ' 设置Term行的起止
    startRow = 4  ' 假设Term数据从第4行开始
    endRow = 102  ' 假设Term数据到第102行 (共99个Term)
    
    ' 逐一复制Currency对应的数据
    For c = startColumn To endColumn
        currencyCode = 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_" & currencyCode
        wsRun.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 Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long, lastColumn As Long
    Dim r As Long, c As Long
    Dim startRow As Long, endRow As Long, startColumn As Long, endColumn As Long
    Dim currencyColumn As Integer
    Dim weightRange As Range, termRange As Range
    Dim targetRow As Long
    Dim currencyCode As String
    Dim weightName As String
    Dim 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).Row
    lastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 找到符合条件的数据行列范围
    For c = 1 To lastColumn
        If wsSource.Cells(1, c).Value = selectedStock And wsSource.Cells(2, c).Value = selectedMarket Then
            currencyCode = wsSource.Cells(3, c).Value
            currencyColumnMap(currencyCode) = c
        End If
    Next c
    
    ' 设置Term行的起止
    startRow = 4  ' 假设Term数据从第4行开始
    endRow = 102  ' 假设Term数据到第102行 (共99个Term)
    
    ' 逐一复制Currency对应的数据
    For Each currencyCode In currencyColumnMap.Keys
        c = 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_" & currencyCode
        wsRun.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列位置的变化。

总结

仍存在缺陷，稍后会更新