Макрос для выбора определенных столбцов из нескольких CSV и импорта в один лист - PullRequest
0 голосов
/ 15 января 2019

У меня несколько CSV в одном каталоге, мне нужно выбрать конкретные файлы вместо всего каталога, и я хочу иметь возможность выбрать нужный столбец (X) и импортировать его в один лист!

Я уже сделал код выше, но я пытаюсь добавить поле ввода, которое дает возможность выбрать столбец, который я хочу извлечь из каждого CSV. Более того, всякий раз, когда я импортирую CSV, они сортируются неправильно. Я обнаружил, что мне нужно применить эту формулу ""=LEFT(F1;1)&TEXT(SUBSTITUTE(F1;LEFT(F1;1);"";"00") " ", но любая идея, как применить в коде, чтобы переименовать файлы .csv.

Sub ImportCSVsWithReferenceI()

Dim xSht As Worksheet
Dim xWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xCount As Long
Dim Newname As String

On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
    xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
Set xSht = ThisWorkbook.ActiveSheet.Add

Newname = InputBox("Name for new worksheet?")
If Newname <> "" Then
    Sheets.Add Type:=xlWorksheet
    ActiveSheet.Name = Newname
 End If
Set xSht = ThisWorkbook.ActiveSheet


If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then
    xSht.UsedRange.Clear
    xCount = 1
Else
    xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column + 1
End If
Application.ScreenUpdating = False

xFile = Dir(xStrPath & "\" & "*.csv")

Do While xFile <> ""
    Set xWb = Workbooks.Open(xStrPath & "\" & xFile)

    Rows(1).Insert xlShiftDown
    Range("A1") = ActiveSheet.Name

    ActiveSheet.UsedRange.Copy xSht.Cells(1, xCount)
    xWb.Close False
    xFile = Dir
    xCount = xSht.Cells(3, Columns.Count).End(xlToLeft).Column + 1

Loop
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
    MsgBox "error"
End Sub

Пример данных (иногда я хочу извлечь столбцы A или B или C или ....:

enter image description here

Пример результата:
enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...