Данные, скопированные из Excel (по крайней мере, один из форматов) - это текст, разделённый табуляцией и переводами строк.
Колонки преобразуются в коллекции (объекты Collection), которые помещаются или в коллекцию, или в словарь (объект Dictionary) - при наличии у столбца заголовка.
- Код: Выделить всё
Public Function FromTable(s As String, Optional WithHeader As Boolean = True, _
Optional Delimiter As String = vbTab) As Object
Dim TC As Collection, TD As Dictionary, Columns() As Collection
Dim Rows() As String, Row() As String, Header() As String
Dim iRow As Long, nRows As Long, iColumn As Long, nColumns As Long, nCurColumns As Long
If Len(Delimiter) <> 0 Then
If WithHeader = True Then
Set TD = New Dictionary
Rows = Split(s, vbCrLf)
nRows = UBound(Rows)
If nRows <> -1 Then
Header = Split(Rows(0), Delimiter)
nColumns = UBound(Header)
ReDim Preserve Columns(nColumns)
For iColumn = 0 To nColumns
Set Columns(iColumn) = New Collection
TD.Add Header(iColumn), Columns(iColumn)
Next iColumn
For iRow = 1 To nRows
Row = Split(Rows(iRow), Delimiter)
nCurColumns = UBound(Row)
If nCurColumns > nColumns Then
nCurColumns = nColumns
End If
For iColumn = 0 To nCurColumns
Columns(iColumn).Add Row(iColumn)
Next iColumn
For iColumn = nColumns + 1 To nColumns
Columns(iColumn).Add vbNullString
Next iColumn
Next iRow
Set FromTable = TD
End If
Else
Set TC = New Collection
Rows = Split(s, vbCrLf)
nRows = UBound(Rows)
If nRows <> -1 Then
Row = Split(Rows(0), Delimiter)
nColumns = UBound(Row)
ReDim Preserve Columns(nColumns)
For iColumn = 0 To nColumns
Set Columns(iColumn) = New Collection
TC.Add Columns(iColumn)
Columns(iColumn).Add Row(iColumn)
Next iColumn
For iRow = 1 To nRows
Row = Split(Rows(iRow), Delimiter)
nCurColumns = UBound(Row)
If nCurColumns > nColumns Then
nCurColumns = nColumns
End If
For iColumn = 0 To nCurColumns
Columns(iColumn).Add Row(iColumn)
Next iColumn
For iColumn = nColumns + 1 To nColumns
Columns(iColumn).Add vbNullString
Next iColumn
Next iRow
Set FromTable = TC
End If
End If
End If
End Function
Public Function IsCollection(a) As Boolean
If IsObject(a) Then
If ObjPtr(a) <> 0 Then
If TypeOf a Is Collection Then
IsCollection = True
End If
End If
End If
End Function
Public Function ToTable(obj As Object, Optional Delimiter As String = vbTab) As String
Dim iColumn As Long, nColumns As Long
Dim iRow As Long, nRows As Long, Items(), Columns() As Collection
If (Len(Delimiter) <> 0) And IsObject(obj) Then
If ObjPtr(obj) <> 0 Then
If TypeOf obj Is Dictionary Then
nColumns = obj.Count - 1
If nColumns >= 0 Then
Items = obj.Items
ReDim Preserve Columns(nColumns)
For iColumn = 0 To nColumns
If IsCollection(Items(iColumn)) = True Then
Set Columns(iColumn) = Items(iColumn)
Else
Exit Function
End If
Next iColumn
End If
ElseIf TypeOf obj Is Collection Then
nColumns = obj.Count - 1
If nColumns >= 0 Then
ReDim Preserve Columns(nColumns)
For iColumn = 0 To nColumns
If IsCollection(obj(iColumn + 1)) Then
Set Columns(iColumn) = obj(iColumn + 1)
Else
Exit Function
End If
Next iColumn
End If
Else
Exit Function
End If
For iRow = 1 To Columns(0).Count
For iColumn = 0 To nColumns
ToTable = ToTable & Columns(iColumn)(iRow)
If iColumn <> nColumns Then
ToTable = ToTable & Delimiter
Else
ToTable = ToTable & vbCrLf
End If
Next iColumn
Next iRow
End If
End If
End Function