' 产品定义平台基础数据格式转换
Sub transferData()
    Dim orgDataSheetName As String, newDataSheetName As String
    orgDataSheetName = "女性"
    newDataSheetName = "sheet_2"
    
    Dim newSheetStartRow As Integer
    newSheetStartRow = 1
    
    ActiveWorkbook.Worksheets.Add(after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)).Name = newDataSheetName
    
    Set factorsRange = Worksheets(orgDataSheetName).Range("B6:B43")
    ' 保单年度
    Set ContYearRange = Worksheets(orgDataSheetName).Range("C5:L5")
    
    Dim i
    Dim factorsRangeRows, factorsRangeCols
    factorsRangeRows = factorsRange.Rows.Count
    factorsRangeCols = factorsRange.Columns.Count
    
    Dim ContYearRangeCols
    ContYearRangeCols = ContYearRange.Columns.Count
        
    For i = 1 To factorsRangeRows
        ' 复制左侧因子
        Worksheets(orgDataSheetName).Select
        Range(Cells(i + factorsRange.Row - 1, factorsRange.Column), Cells(i + factorsRange.Row - 1, factorsRangeCols + factorsRange.Column - 1)).Select
        Selection.Copy
        
        Worksheets(newDataSheetName).Select
        Range(Cells(newSheetStartRow, 1), Cells(newSheetStartRow + ContYearRangeCols - 1, factorsRangeCols)).Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        
        ' 复制保单年度，需转置
        Worksheets(orgDataSheetName).Select
        ContYearRange.Select
        Selection.Copy
        
        Worksheets(newDataSheetName).Select
        Range(Cells(newSheetStartRow, factorsRangeCols + 1), Cells(newSheetStartRow + ContYearRangeCols - 1, factorsRangeCols + 1)).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        
        ' 复制费率，需转置
        Worksheets(orgDataSheetName).Select
        Range(Cells(ContYearRange.Row + i, ContYearRange.Column), Cells(ContYearRange.Row + i, ContYearRange.Column + ContYearRange.Columns.Count - 1)).Select
        Selection.Copy
        
        Worksheets(newDataSheetName).Select
        Range(Cells(newSheetStartRow, factorsRangeCols + 2), Cells(newSheetStartRow + ContYearRangeCols - 1, factorsRangeCols + 2)).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        
        newSheetStartRow = newSheetStartRow + ContYearRangeCols
    Next
    
End Sub

Sub deleteBlankRows()
    ' http://club.excelhome.net/thread-314006-1-1.html
    ' Deletes the entire row within the selection if the ENTIRE row contains no data.
    ' 删除所选区域内空行
    ' We use Long in case they have over 32,767 rows selected.
    ' 我们用长整型以免出错
    Dim i As Long
    
    ' 需做清理的sheet索引
    Dim sheetIndex As Integer
    sheetIndex = 1
    
    'We turn off calculation and screenupdating to speed up the macro. 关掉自动重算和屏幕刷新以提高速度
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    
    Dim endRowIndex As Long
    endRowIndex = Sheets(sheetIndex).UsedRange.rows.Count
    
    'We work backwards because we are deleting rows. 由于要删除行，所以要FOR NEXT要倒着来
    For i = endRowIndex To 1 Step -1
        If WorksheetFunction.CountA(Sheets(sheetIndex).rows(i)) = 0 Then
            Sheets(sheetIndex).rows(i).EntireRow.Delete
        End If
    Next i

        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

' 按指定列查询，若存在满足条件的单元格，则删除单元格所有行，且下面单元格上移
Sub clearRows()
    ' 需做清理的sheet索引
    Dim sheetIndex As Integer
    sheetIndex = 1
    
    ' 定义查找列开始、结束行索引位置
    Dim startRowIndex As Long, endRowIndex As Long
    startRowIndex = 1
    ' endRowIndex = Sheets(sheetIndex).[A65536].End(xlUp).row '指定列的有效行数
    endRowIndex = Sheets(sheetIndex).UsedRange.rows.Count ' 显示数据的最大行数
    
    Dim sColLetter As String, lookup_value As String
    sColLetter = "A"
    lookup_value = "1"
    
    ' 定义开始、结束单元格式位置
    Dim startCellAddress As String, endCellAddress As String
    endCellAddress = sColLetter + Str(endRowIndex) ' 指定列的最后一个单元格
    endCellAddress = Replace(endCellAddress, " ", "")
        
    Do
        startCellAddress = sColLetter + Str(startRowIndex)
        startCellAddress = Replace(startCellAddress, " ", "")
        
        Set newLookupRange = Range(startCellAddress + ":" + endCellAddress)
        ' Set matchcell = newLookupRange.Find(what:=lookup_value)
        Set matchcell = newLookupRange.Find(what:=lookup_value, LookAt:=xlWhole)
        
        If matchcell Is Nothing Then
            GoTo exitLoop
        End If
        
        startRowIndex = matchcell.row
        
        rows(matchcell.row & ":" & matchcell.row).Delete Shift:=xlUp
        
    Loop While 1 = 1
    
    Exit Sub
    
exitLoop:

End Sub

' ======================================================================================================
' 所有范围内查询，若存在满足条件的单元格，则删除单元格所有行，且下面单元格上移
Sub clearRows()
    ' 需做清理的sheet索引
    Dim sheetIndex As Integer
    sheetIndex = 1
    
    ' 定义查找列开始、结束行索引位置
    Dim endRowIndex As Long
    endRowIndex = Sheets(sheetIndex).UsedRange.rows.Count
    
    Dim lookup_value As String
    lookup_value = "t1"
    
    ' 定义开始、结束单元格式位置
    Dim startCellAddress As String, endCellAddress As String
    startCellAddress = "A1"
    
    ' 显示数据的最后一个单元格，用于指定所有区域内的查询删除
    endCellAddress = ColLetter(Sheets(sheetIndex).UsedRange.Columns.Count) + Str(endRowIndex)
    endCellAddress = Replace(endCellAddress, " ", "")
    
    Set lookupRange = Range(startCellAddress + ":" + endCellAddress)
    
    Do
        Set matchcell = lookupRange.Find(what:=lookup_value, LookAt:=xlWhole)
        
        If matchcell Is Nothing Then
            GoTo exitLoop
        End If
        
        rows(matchcell.row & ":" & matchcell.row).Delete Shift:=xlUp
    Loop While 1 = 1
    
    Exit Sub
    
exitLoop:

End Sub

' 根据列字母返回列索引
Function ColIndex(colName As String) As Integer
    On Error GoTo Errorhandler
    
    ColIndex = Range(colName & "1").Column
    
    Exit Function
    
Errorhandler:
    MsgBox "Error encountered, please re‐enter "
End Function

' 注意：文件夹路径需以"\"结尾

' 复制文件夹
Sub copyFolderSub()
    Dim sourcePath As String, destinationPath As String
    sourcePath = "D:\temp\vbamerge\"
    destinationPath = "D:\temp\vbamerge2\"
    Call copyFolderFn(sourcePath, destinationPath)
End Sub

' 复制文件夹
Private Function copyFolderFn(sourcePath As String, destinationPath As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Dir(destinationPath, 16) = Empty Then
        ' 文件夹不存在，需创建
        ' 方法一： VBA创建
        'VBA.MkDir destinationPath
        
        ' 方法二： FileSystemObject
        fso.CreateFolder destinationPath
    End If
    
    Set f = fso.GetFolder(sourcePath)
    
    ' 复制单个文件
    Set fc = f.Files
    For Each f1 In fc
        ' 可再设置条件复制 eg:
        ' excel文件： Right(f1.Name, 4) = "xlsx" or Right(f1.Name, 3) = "xls"
        FileCopy f1.path, destinationPath & f1.Name
    Next
    
    ' 复制子文件夹
    Set fcfolders = f.SubFolders
    ' MsgBox fcFolders.Count
    For Each ff In fcfolders
        Call copyFolderFn(sourcePath & ff.Name & "\", destinationPath & ff.Name & "\")
    Next
End Function

Sub mergeFiles()
    Dim sourcePath As String
    sourcePath = "D:\temp\vbamerge\"
    
    Call mergeFilesFn(sourcePath)
    
End Sub

' 将指定目录下的所有文件，包手子目录下的文件，合并至当前执行宏的第1张sheet中
' 均只合并文件中的第1张sheet
Private Function mergeFilesFn(sourcePath As String, Optional rowIndex As Long = 1)
    ' 列字母索引
    Dim sColLetter As String
    Dim columnss As Integer
    
    Dim fs, f, f1, fc, s, rowss
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(sourcePath) 'Directory of excel files will be merge
    Set fc = f.Files
          
    ' 文件
    For Each f1 In fc
        If Right(f1.Name, 4) = "xlsx" Or Right(f1.Name, 3) = "xls" Then
            Workbooks.Open (f1.path)
            rowss = Workbooks(f1.Name).Sheets(1).Range("A65536").End(xlUp).row
            ' columnss = Workbooks(f1.Name).Sheets(1).Columns.Count ' sheet最大列数
            columnss = Workbooks(f1.Name).Sheets(1).UsedRange.Columns.Count ' 显示数据的最大列数
            
            sColLetter = ColLetter(columnss)
            ' MsgBox sColLetter & " = " + CStr(columnss)
              
            ' Workbooks(f1.Name).Sheets(1).Range("A1:z" & CStr(rowss)).Copy
            Workbooks(f1.Name).Sheets(1).Range("A1:" & sColLetter & CStr(rowss)).Copy
            Workbooks(1).Activate
            'Workbooks(1).Sheets(1).Range("A" & CStr(rowIndex) & ":z" & CStr(rowIndex + rowss)).Select
            Workbooks(1).Sheets(1).Range("A" & CStr(rowIndex) & ":" & sColLetter & CStr(rowIndex + rowss)).Select
            Workbooks(1).Sheets(1).Paste
            Application.CutCopyMode = False
              
            rowIndex = rowIndex + rowss
            Workbooks(f1.Name).Close savechanges:=False
        End If
    Next
    
    ' 子目录
    Set subfc = f.SubFolders
    For Each ff In subfc
        Call mergeFilesFn(sourcePath & ff.Name & "\", rowIndex)
    Next

End Function

' 获取列字母
Function ColLetter(ColNumber As Integer) As String
    On Error GoTo Errorhandler
    ColLetter = Left(Cells(1, ColNumber).Address(0, 0), 1 - (ColNumber > 26))
    Exit Function
    
Errorhandler:
    MsgBox "Error encountered, please re‐enter "
End Function

' FindNext有个致命的Bug，那就是它只能用于Sub过程里面，不能用于Function过程里面。
Sub testFindNext()    
    Dim lookup_vector As Range, result_vector As Range
    Dim lookup_value As String, FirstAddress As String
    Dim LISTAGG As String, ch As String
    
    ch = ", "
    
    lookup_value = Sheet1.Range("A3").Value
    Set lookup_vector = Range("B1:B111")
    Set result_vector = Range("C1:C111")
    
    With lookup_vector
        Set matchcell = .Find(what:=lookup_value)
        
        If Not matchcell Is Nothing Then
            FirstAddress = matchcell.Address
              
            Do
                If LISTAGG <> "" Then
                    LISTAGG = LISTAGG + ch
                End If
                LISTAGG = LISTAGG + Cells(matchcell.row, result_vector.Column)

                Set matchcell = .FindNext(after:=matchcell)

            Loop Until (matchcell Is Nothing) Or (matchcell.Address = FirstAddress)
        End If
    End With
    MsgBox LISTAGG
End Sub

' 2015-03-19
' 参照LOOKUP和VLOOKUP参数设置；
' 参考lookup参数设置
' lookup_value 第一个矢量中搜索到的值
' lookup_vector 是一个仅包含一列的区域
' result_vector 是一个仅包含一列的区域
' Optional ch As String = ","：合并后的分割符，可自定义，默认为英文逗号（”,”）
' 【后续处理】可选参数的容错处理
Function LISTAGG(lookup_value As String, lookup_vector As Range, Optional result_vector As Range, Optional ch As String = ", ", Optional removal As Boolean = True)
    If result_vector Is Nothing Then
        result_vector = lookup_vector
    End If
    
    ' 定义查找列字母索引
    Dim lookupColLetter As String
    lookupColLetter = ColLetter(lookup_vector.Column)
         
    ' 定义查找列开始、结束行索引位置
    Dim startRowIndex As Long, endRowIndex As Long
    startRowIndex = lookup_vector.Row
    endRowIndex = lookup_vector.Rows.Count
        
    ' 定义开始、结束单元格式位置
    Dim startCellAddress As String, endCellAddress As String
        
    endCellAddress = lookupColLetter + Str(endRowIndex)
    endCellAddress = Replace(endCellAddress, " ", "")
        
    ' 定义返回结果集合
    Dim resultCollection As Collection
    Set resultCollection = New Collection
      
    ' 定义查找到的单元格内容
    Dim resultCellValue As String
      
    Dim lastAdrress As String
    lastAdrress = ""
    Do
        cCount = cCount + 1
        startCellAddress = lookupColLetter + Str(startRowIndex)
        startCellAddress = Replace(startCellAddress, " ", "")
        
        Set newLookupRange = Range(startCellAddress + ":" + endCellAddress)
        ' Set matchcell = newLookupRange.Find(what:=lookup_value)
        Set matchcell = newLookupRange.Find(what:=lookup_value, LookAt:=xlWhole)
            
        If matchcell Is Nothing Or lastAdrress = matchcell.Address Then
            GoTo exitLoop
        End If
          
        lastAdrress = matchcell.Address
        resultCellValue = Cells(matchcell.Row, result_vector.Column)
        
        If removal Then
            ' 去重
            If Contains(resultCollection, resultCellValue) = False Then
                resultCollection.Add resultCellValue
            End If
        End If
          
        startRowIndex = matchcell.Row
    Loop While 1 = 1
        
exitLoop:
    Dim i As Long ' 遍历索引
    For i = 1 To resultCollection.Count
        If LISTAGG <> "" Then
            LISTAGG = LISTAGG + ch
        End If
            
        LISTAGG = LISTAGG + resultCollection.Item(i)
    Next i
        
End Function
  
Private Function Contains(coll As Collection, v As String) As Boolean
    Dim i As Long
      
    Contains = False
    For i = 1 To coll.Count
        If v = coll.Item(i) Then
            Contains = True
            GoTo exitfor
        End If
    Next i
exitfor:
      
End Function
    
' 获取列字母
Function ColLetter(ColNumber As Integer) As String
    On Error GoTo Errorhandler
    ColLetter = Left(Cells(1, ColNumber).Address(0, 0), 1 - (ColNumber > 26))
    Exit Function
    
Errorhandler:
    MsgBox "Error encountered, please re‐enter "
End Function

Option Explicit

Dim SQLSheetNameStartWith As String
Dim VOUCHERSheetName As String

Private Sub init()
    SQLSheetNameStartWith = "【SQL】"
    VOUCHERSheetName = "【SQL】VOUCHER_DETAIL"
    
End Sub

Sub benefit()
'
' benefit Macro
' 我的权益
'

'
' insert into member_voucher (VOUCHER_ID, VOUCHER_NAME, VOUCHER_START_DATE, VOUCHER_END_DATE, VOUCHER_DESCRIPTION, VOUCHER_DETAIL, VOUCHER_AMOUNT, VOUCHER_RECEIPT_AMOUNT, OPERATOR, MAKEDATE)
' values (12, '携程10012元现金卷_12', to_date('06-01-2015', 'dd-mm-yyyy'), to_date('31-01-2015', 'dd-mm-yyyy'), '携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12', '携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12_携程10012元现金卷_12', 7, 4, 0, to_date('06-01-2015 09:27:25', 'dd-mm-yyyy hh24:mi:ss'));

    Call init
    
    Dim i As Integer, index As Integer
    Dim sqlSheetName As String
    
    ' member_voucher fields
    Dim VOUCHER_ID As String
    Dim VOUCHER_NAME As String
    Dim VOUCHER_START_DATE As String
    Dim VOUCHER_END_DATE As String
    Dim VOUCHER_DESCRIPTION As String
    Dim VOUCHER_DETAIL As String
    Dim VOUCHER_AMOUNT As String
    Dim VOUCHER_RECEIPT_AMOUNT As String
    Dim OPERATOR As String
    Dim MAKEDATE As String
    
    Dim localSheets As Sheets
    Set localSheets = ActiveWorkbook.Worksheets
    
    For i = 1 To localSheets.Count
        
        'Call alert(Format(Date, "yyyy/mm/dd hh:mm:ss.000"))

        VOUCHER_RECEIPT_AMOUNT = "0"
        OPERATOR = "0"
        MAKEDATE = "sysdate"
        
        If InStr(1, localSheets(i).Name, SQLSheetNameStartWith) = 0 Then
            ' 不是SQL sheet时，才生成对应的SQL sheet
            sqlSheetName = SQLSheetNameStartWith + localSheets(i).Name
            localSheets.Add(after:=localSheets(localSheets.Count)).Name = sqlSheetName
            ' 激活新建的工作表
            ActiveWorkbook.Worksheets(sqlSheetName).Select
            
            VOUCHER_ID = localSheets(i).Cells(2, 2).Value
            VOUCHER_NAME = localSheets(i).Cells(2, 3).Value
            
            VOUCHER_START_DATE = localSheets(i).Cells(2, 6).Value
            index = InStr(VOUCHER_START_DATE, "至")
            VOUCHER_END_DATE = Mid(VOUCHER_START_DATE, index + 1, Len(VOUCHER_START_DATE))
            VOUCHER_START_DATE = Mid(VOUCHER_START_DATE, 1, index - 1)
            
            VOUCHER_DESCRIPTION = ActiveWorkbook.Worksheets(VOUCHERSheetName).Cells(i + 1, 1)
            VOUCHER_DETAIL = ActiveWorkbook.Worksheets(VOUCHERSheetName).Cells(i + 1, 2)
            
            VOUCHER_AMOUNT = localSheets(i).[A65536].End(xlUp).Row - 1
            
            Dim sql As String
            sql = "insert into member_voucher (VOUCHER_ID, VOUCHER_NAME, VOUCHER_START_DATE, VOUCHER_END_DATE, VOUCHER_DESCRIPTION, VOUCHER_DETAIL, VOUCHER_AMOUNT, VOUCHER_RECEIPT_AMOUNT, OPERATOR, MAKEDATE)"
            sql = sql + "values ("
            sql = sql + VOUCHER_ID + ", "
            sql = sql + "'" + VOUCHER_NAME + "', "
            sql = sql + "date '" + VOUCHER_START_DATE + "', "
            sql = sql + "date '" + VOUCHER_END_DATE + "', "
            sql = sql + "'" + VOUCHER_DESCRIPTION + "', "
            sql = sql + "'" + VOUCHER_DETAIL + "', "
            sql = sql + VOUCHER_AMOUNT + ", "
            sql = sql + VOUCHER_RECEIPT_AMOUNT + ", "
            sql = sql + "'" + OPERATOR + "', "
            sql = sql + MAKEDATE
            sql = sql + ");"
            ActiveWorkbook.Worksheets(sqlSheetName).Cells(1, 1) = sql
            
            For index = 2 To localSheets(i).[A65536].End(xlUp).Row
                ' insert into member_voucher_detail (VOUCHER_ID, VOUCHER_CODE, MAKEDATE)
                ' values (10, '05830cd3b71547b3908d7356422ec430', to_date('06-01-2015', 'dd-mm-yyyy'))
                Dim VOUCHER_CODE As String
                VOUCHER_CODE = localSheets(i).Cells(index, 8).Value
                
                sql = "insert into member_voucher_detail (VOUCHER_ID, VOUCHER_CODE, MAKEDATE)"
                sql = sql + "values ("
                sql = sql + VOUCHER_ID + ", "
                sql = sql + "'" + VOUCHER_CODE + "', "
                sql = sql + "sysdate"
                sql = sql + ");"
                ActiveWorkbook.Worksheets(sqlSheetName).Cells(index, 1) = sql
            Next index
            
        End If
        
    Next
    
    Call alert("完成。。。")

End Sub

Private Sub alert(msg As String)
    MsgBox msg, 0, "title"
End Sub

参考Oracle的列转行函数（LISTAGG()）命名；功能类似；
版本1：
/**
 * rng As Range：选中的区域
 * Optional ch As String = ","：合并后的分割符，可自定义，默认为英文逗号（”,”）
 */
Public Function LISTAGG(rng As Range, Optional ch As String = ",")
    Dim i As Long
    Dim rows As Long
    rows = rng.rows.Count '选定区域总行数
    
    Set DataRange = rng.CurrentRegion
    For i = 1 To rows
        If i > 1 Then
            LISTAGG = LISTAGG + ch
        End If
        LISTAGG = LISTAGG + DataRange(i, 1)
    Next i
End Function

调用示例
=listagg(C3:C20)，按英文逗号合并C3至C20间的内容；
=listagg(C3:C20, " ")，按指定的空格合并C3至C20间的内容；

================================================================================
版本2：
参照LOOKUP和VLOOKUP参数设置；
' 参考lookup参数设置
' lookup_value 第一个矢量中搜索到的值
' lookup_vector 是一个仅包含一列的区域
' result_vector 是一个仅包含一列的区域
' Optional ch As String = ","：合并后的分割符，可自定义，默认为英文逗号（”,”）
' 【注意项】
' 1、最好指定明确的区域，如H2:H235，若指定为H:H，则效率会很慢
Public Function LISTAGG(lookup_value As String, lookup_vector As Range, Optional result_vector As Range, Optional ch As String = ",")
    
    Dim lookup_vector_len As Long, result_vector_len As Long
    lookup_vector_len = lookup_vector.rows.Count '查询区域总行数
    result_vector_len = result_vector.rows.Count '结果区域总行数
    
    Dim i As Long
    'Set lookDataRange = lookup_vector.CurrentRegion
    'Set resultDataRange = result_vector.CurrentRegion
    
    LISTAGG = ""
    ' 方法一
    'For i = 1 To lookup_vector_len
    '    If lookup_value = Cells(lookup_vector.Row + i - 1, lookup_vector.Column) Then
    '        If LISTAGG <> "" Then
    '            LISTAGG = LISTAGG + ch
    '        End If
    '        LISTAGG = LISTAGG + Cells(result_vector.Row + i - 1, result_vector.Column)
    '    End If
    'Next i

    ' 方法二，此方法本质还是Range
    'For Each c In lookDataRange
    '    If lookup_value = c.Value Then
    '        If LISTAGG <> "" Then
    '            LISTAGG = LISTAGG + ch
    '        End If
    '        LISTAGG = LISTAGG + Cells(result_vector.Row + c.Row - 1, result_vector.Column)
    '    End If
    'Next c
    
    ' 方法三
    Dim lookupColLetter As String
    lookupColLetter = ColLetter(lookup_vector.Column)
     
    Dim startRowIndex As Long, endRowIndex As Long
    startRowIndex = lookup_vector.Row
    endRowIndex = lookup_vector.Rows.Count
    
    Dim startCellAddress As String, endCellAddress As String
    
    endCellAddress = lookupColLetter + Str(endRowIndex)
    endCellAddress = Replace(endCellAddress, " ", "")
    
    Do
        startCellAddress = lookupColLetter + Str(startRowIndex)
        startCellAddress = Replace(startCellAddress, " ", "")
    
        Set newLookupRange = Range(startCellAddress + ":" + endCellAddress)
        Set matchcell = newLookupRange.Find(what:=lookup_value)
        
        If matchcell Is Nothing Then
            GoTo exitLoop
        End If
        
        If LISTAGG <> "" Then
            LISTAGG = LISTAGG + ch
        End If
        
        LISTAGG = LISTAGG + Cells(matchcell.Row, result_vector.Column)
        startRowIndex = matchcell.Row + 1
    Loop While 1 = 1
    
exitLoop:
    
    If LISTAGG = "" Then
        LISTAGG = "test 123456"
    End If
End Function

' 获取列字母
Function ColLetter(ColNumber As Integer) As String
    On Error GoTo Errorhandler
    ColLetter = Left(Cells(1, ColNumber).Address(0, 0), 1 - (ColNumber > 26))
    Exit Function

Errorhandler:
    MsgBox "Error encountered, please re‐enter "
End Function

【问题】
http://blog.sina.com.cn/s/blog_6b8f217e0100uv0q.html
FindNext有个致命的Bug，它只能用于Sub过程里面，不能用于Function过程里面。
后来我改为Sub过程试试，竟然调试通过。于是，我上网查询一下是否已经有人遇到类似问题，果然是FindNext函数的问题，不能用于Function。还有人说不能用于带参数的Sub过程，本人没有验证。
重要提示，我所说的不能用于Function，是如果用户直接在工作表中使用该自定义函数，那么FindNext不工作，返回错误值。如果在代码窗口，创建一个Sub，在Sub里面调用自定义函数，可以返回正确结果。