首页 > 解决方案 > 用于从多个 csv 中选择特定列并导入到一个工作表的宏

问题描述

我在一个目录中有多个 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 或 ....:

在此处输入图像描述

结果示例:
在此处输入图像描述

标签: excelvbacsv

解决方案


推荐阅读