Это в стандартный модуль.
Скрытый текст |
---|
Option Explicit
Sub LoadCSV_C7() Load_CSV Range("C7").Value, Range("A20") End Sub
Public Sub Load_CSV(ByVal sName As String, rOut As Range)
Dim sPath As String sPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\" sName = sName & ".csv" Dim sFull As String sFull = sPath & sName Dim fso As Object Set fso = CreateObject("Scripting.Filesystemobject") Dim ss As String If fso.FileExists(sFull) Then With fso.OpenTextFile(sFull) ss = .ReadAll .Close End With End If Dim arr As Variant If ss <> "" Then arr = GetArrFromStr(ss) End If PrintArray arr, rOut End Sub
Private Sub PrintArray(arr As Variant, rOut As Range) With rOut.Cells(1, 1) .Resize(.Parent.UsedRange.Rows.Count, .Parent.UsedRange.Columns.Count).ClearContents If Not IsEmpty(arr) Then .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End If End With End Sub
Private Function GetArrFromStr(ss As String) As Variant Dim arr As Variant arr = Split(ss, vbCrLf) ss = "" Dim brr As Variant Dim crr As Variant Dim ya As Long Dim xb As Long ReDim crr(LBound(arr) To UBound(arr)) For ya = LBound(arr) To UBound(arr) brr = Split(arr(ya), ";") crr(ya) = brr If xb < UBound(crr(ya)) - LBound(crr(ya)) + 1 Then xb = UBound(crr(ya)) - LBound(crr(ya)) + 1 Next arr = Empty brr = Empty If xb = 0 Then Exit Function ReDim brr(1 To UBound(crr) - LBound(crr) + 1, 1 To xb) For ya = LBound(crr) To UBound(crr) If UBound(crr(ya)) >= LBound(crr(ya)) Then For xb = 1 To UBound(brr, 2) brr(ya + 1 - LBound(crr), xb) = crr(ya)(xb - (1 - LBound(crr(ya)))) Next End If Next GetArrFromStr = brr End Function |
Это в модуль листа Данные.
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C7")) Is Nothing Then
Load_CSV Range("C7").Value, Range("A20")
End If
End Sub
|