在 Excel 中连接 3d 范围

Question

如何修改此 UDF 以适应多张纸的 3d 范围？

Function ConcatenateRange(ByVal cell_range As range, _
                Optional ByVal seperator As String) As String

Dim cell As range
Dim newString As String
Dim cellArray As Variant
Dim i As Long, j As Long

cellArray = cell_range.Value

For i = 1 To UBound(cellArray, 1)
For j = 1 To UBound(cellArray, 2)
    If Len(cellArray(i, j)) <> 0 Then
        newString = newString & (seperator & cellArray(i, j))
    End If
Next
Next

If Len(newString) <> 0 Then
newString = Right$(newString, (Len(newString) - Len(seperator)))
End If

ConcatenateRange = newString

End Function

这行得通:)

=ConcatenateRange(C4:C16)

但是这个没有:(

=ConcatenateRange(sheet1:sheet5!B1)

Answer 1

这是一个涵盖多张工作表的版本，但由于它使用 String 变量作为输入，因此可能存在波动性问题：

Option Explicit
Function ConcatenateRange(ByVal cell_string As String, _
                Optional ByVal separator As String) As String
    Application.Volatile
    Dim newString As String
    Dim ary1 As Variant, ary2 As Variant
    Dim cell_range As Range
    Dim cellArray As Variant
    Dim i As Long, J As Long, K As Long
    Dim sh As Worksheet
    ConcatenateRange = ""
    Dim sheet_col As Collection
    Set sheet_col = New Collection
    If InStr(cell_string, "!") > 0 Then
        ary1 = Split(cell_string, "!")
        If InStr(ary1(LBound(ary1)), ":") > 0 Then
            ary2 = Split(ary1(LBound(ary1)), ":")
            For i = LBound(ary2) To UBound(ary2)
                sheet_col.Add Sheets(ary2(i))
            Next i
        Else
            sheet_col.Add Sheets(ary1(LBound(ary1)))
        End If
    Else
        sheet_col.Add Sheets(Application.Caller.Parent.Name)
        ReDim ary1(1 To 1)
        ary1(1) = cell_string
    End If


    For K = 1 To sheet_col.Count
        Set sh = sheet_col(K)
        Set cell_range = sh.Range(ary1(UBound(ary1)))
        If cell_range.Count = 1 Then
            ReDim cellArray(1 To 1, 1 To 1)
            cellArray(1, 1) = cell_range.Value
        Else
            cellArray = cell_range.Value
        End If
        For i = 1 To UBound(cellArray, 1)
            For J = 1 To UBound(cellArray, 2)
                If Len(cellArray(i, J)) <> 0 Then
                    newString = newString & (separator & cellArray(i, J))
                End If
            Next
        Next
        If Len(newString) <> 0 Then
            newString = Right$(newString, (Len(newString) - Len(separator)))
        End If
        ConcatenateRange = ConcatenateRange & newString
    Next K
End Function

应与以下语法一起使用：

=ConcatenateRange("A1:E1",".")
=ConcatenateRange("Sheet1!A1:E1",".")
=ConcatenateRange("Sheet2!A1:E1",".")
=ConcatenateRange("Sheet2!A1:E1",".")
=ConcatenateRange("Sheet1:Sheet2!A1",".")