VBA Excel导入

Question

我已经在过去的几个小时里看过不同的解决方案和代码，但都没有工作过（新手到VBA）。 我从另一个使用俄语字符的网站接收文件，我需要将这些文件导入到最后一个使用行下面的现有电子表格以及数据使用Windows西里尔字符。

现有的电子表格确实有列，你知道我将如何格式化数据，以便在现有列标题下导入数据。

该数据是标签式的，但目前没有任何标题。

我设法找到一些适用于导入的代码，但是这将它放在单元格A1中，使其具有宏而不是另一个工作表并且没有列。任何帮助，将不胜感激。

Sub DoThis() 
Dim TxtArr() As String, I As Long 
'TxtArr = BrowseForFile("C:\Users\rjoss\Desktop\SVY") 
TxtArr = Split(OpenMultipleFiles, vbCrLf) 
For I = LBound(TxtArr, 1) To UBound(TxtArr, 1) 
    Import_Extracts TxtArr(I) 
Next 
End Sub 
Sub Import_Extracts(filename As String) 
' 
Dim Tmp As String 
Tmp = Replace(filename, ".txt", "") 
Tmp = Mid(Tmp, InStrRev(Tmp, "\") + 1) 
' 
Range("A50000").End(xlUp).Offset(1, 0).Select 
With ActiveSheet.QueryTables.Add(Connection:= _ 
    "TEXT;" & filename _ 
    , Destination:=Range("A50000").End(xlUp).Offset(1, 0)) 
    .Name = Tmp 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .TextFilePromptOnRefresh = False 
    .TextFilePlatform = 850 
    .TextFileStartRow = 1 
    .TextFileParseType = xlDelimited 
    .TextFileTextQualifier = xlTextQualifierDoubleQuote 
    .TextFileConsecutiveDelimiter = False 
    .TextFileTabDelimiter = True 
    .TextFileSemicolonDelimiter = False 
    .TextFileCommaDelimiter = False 
    .TextFileSpaceDelimiter = False 
    .TextFileOtherDelimiter = "~" 
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
ActiveCell.EntireRow.Delete 
End Sub 


'code copied from here and modified to work 
'http://www.tek-tips.com/faqs.cfm?fid=4114 
Function OpenMultipleFiles() As String 
Dim Filter As String, Title As String, msg As String 
Dim I As Integer, FilterIndex As Integer 
Dim filename As Variant 
' File filters 
Filter = "Text Files (*.txt),*.txt" 
' Set Dialog Caption 
Title = "Select File(s) to Open" 
' Select Start Drive & Path 
ChDrive ("C") 
'ChDir ("c:\Files\Imports") 
ChDir ("C:\Users\rjoss\Desktop\SVY") 
With Application 
    ' Set File Name Array to selected Files (allow multiple) 
    filename = .GetOpenFilename(Filter, FilterIndex, Title, , True) 
    ' Reset Start Drive/Path 
    ChDrive (Left(.DefaultFilePath, 1)) 
    ChDir (.DefaultFilePath) 
End With 
' Exit on Cancel 
If Not IsArray(filename) Then 
    MsgBox "No file was selected." 
    Exit Function 
End If 
msg = Join(filename, vbCrLf) 
OpenMultipleFiles = msg 
End Function 

Answer 1

这是用于导入CSV的小型Add-In I use。也许它会帮助你：

• 它开始导入当前选定单元格的数据。
  这个可以在这里改变：Destination:=ActiveCell)。
• 由于您的CSV数据与您现有的Excel列的顺序相同，因此您无需更改任何内容。只需将代码示例中的所有内容导入为文本即可。
• 关于Cyrillic charset：.TextFilePlatform = -535表示使用Unicode charset。 .TextFilePlatform = 855（没有尾随减号）代表OEM西里尔。

---

'=============================================== this code is placed in a new modul ================================================================================== 
Function ImportCSV()       'this function imports the CSV 

    Dim ColumnsType() As Variant    'declares an empty zero-based array. This is the only variable which MUST be declared 
    MyPath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")  'asks the user which CSV file should be imported 
    If MyPath = False Then Exit Function  'if the user aborts the previous question, then exit the whole function 

    ReDim ColumnsType(16383)     'expand the array since excel 2007 and higher has 16384 columns. Excel 2003 is fine with that 
    For i = 0 To 16383       'start a loop with 16383 iterations 
     ColumnsType(i) = 2      'every column should be treated as text (=2) 
    Next i          'repeat the loop and count up variable i 

    If ActiveCell Is Nothing Then 
     Workbooks.Add 
     Application.Wait DateAdd("s", 1, Now) 
     ActiveWorkbook.Windows(1).Caption = Dir(MyPath) 
    End If 

    With ActiveWorkbook.ActiveSheet.QueryTables.Add(Connection:="TEXT;" & MyPath, Destination:=ActiveCell)  'creates the query to import the CSV. All following lines are properties of this 
     .PreserveFormatting = True    'older cell formats are preserved 
     .RefreshStyle = xlOverwriteCells  'existing cells should be overwritten - otherwise an error can occur when too many columns are inserted! 
     .AdjustColumnWidth = True    'adjust the width of all used columns automatically 
     .TextFilePlatform = -535    'import with Unicode charset 
     .TextFileParseType = xlDelimited  'CSV has to be a delimited one - only one delimiter can be true! 
     .TextFileOtherDelimiter = Application.International(xlListSeparator)        'uses system setting => EU countries = ';' and US = ',' 
     .TextFileColumnDataTypes = ColumnsType 'all columns should be treted as pure text 
     .Refresh BackgroundQuery:=False   'this is neccesary so a second import can be done - otherwise the macro can only called once per excel instanz 
    End With         'on this line excel finally starts the import process 

    ActiveWorkbook.ActiveSheet.QueryTables(1).Delete 'deletes the query (not the data) 

End Function         'we are finished