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