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 = -535Unicode 文字セットが使用されていることを示します。 .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 に答える