0

在过去的几个小时里，我一直在研究不同的解决方案和代码，但都没有奏效（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
4

1 回答 1

0

这是我用于导入 CSV 的一个小插件。也许它会帮助你：

  • 它开始在当前选定的单元格处导入数据。
    此时可以更改：Destination:=ActiveCell).
  • 由于您的 CSV 数据与现有 Excel 列的顺序相同，因此您无需更改任何内容。只需将所有内容作为文本导入，如代码示例中所示。
  • 关于西里尔字符集：.TextFilePlatform = -535表示使用了 Unicode 字符集。 .TextFilePlatform = 855（没有尾随减号）代表 OEM Cyrillic。
'=============================================== 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
于 2013-02-14T15:34:53.893 回答