Excel宏,用于选择从CSV导入的内容和位置

时间:2017-02-11 18:10:28

标签: excel vba excel-vba csv

我有一个从我的银行帐户导出的.csv文件,目前正通过Excel自动导入导入Excel,然后用我的宏处理(删除某些列,格式更改,连续等等。没什么特别的。)

然而,.csv文件没有一致的格式,并且有一些列可以更改它们的位置(例如,列“IBAN”有时是第2列,有时是第5列)或根本不存在,导致我的宏崩溃。

我需要的是一些首先使用.csv的代码,检查.csv列中的“IBAN”并在检查后导入它,所以总是让我们说列号。 1,我的宏将处理列号。 1没有问题。

有什么想法吗?

2 个答案:

答案 0 :(得分:1)

这样的事情应该有效,并且相当简单。您还可以使用find函数的其他参数来指定要搜索的位置:

Public Function GetColumnRange(ByVal sSearch As String, r As Object, rSearchArea As Range)
If Not rSearchArea.Find(sSearch, , , xlWhole) Is Nothing Then
    Set r = rSearchArea.Find(sSearch, , , xlWhole)
    r.Select
    GetColumnRange = True
End If

结束功能 Public Sub CSV_Reformat()     Dim wb As Workbook     Dim Ws As Worksheet

Dim arrArgs() As Variant

Dim cColl As Collection

Dim rHolder As Object

Set cColl = New Collection
arrArgs() = Array("IBAN", "Arg2", "Arg3")

' Use the code you have to load the .CSV file and to open it
' Assumes that wb is set to the .CSV file
' Assumes ws is the first sheet in the .CSV file

Set wb = ActiveWorkbook ' Replace this with your actual .CSV file
Set ws = wb.Sheets(1)

For i = LBound(arrArgs()) To UBound(arrArgs())
    If GetColumnRange(arrArgs(i), rHolder, ws.UsedRange) = True Then
        cColl.Add rHolder
    End If
Next

For i = 1 To cColl.Count
    Set rHolder = cColl(i)

    ' Do whatever you need to do with the range here
    ' For example, you could get the column number:

    Debug.Print rHolder.Column
Next

End Sub

如果您的CSV文件较大,我还建议您考虑使用数组。您可以使用以下命令加载数组:

Dim arrData() as Variant
Dim i as Long, Dim j as Long
Dim lOutput as Long
Dim bool as Boolean

' Assumes, as before, that ws is the worksheet we are working in  

arrData() = ws.UsedRange.Value

然后,您可以为输出创建一个新数组:

Dim arrOut() as Variant

redim arrOut(0 to Ubound(arrData()) - 1, 0 to i) 

' Reduce it by one row since we are creating a zero based array. i is the
' number of columns you want in the output.

' Then loop over the data array and put the right columns into your output

For i = 1 to Ubound(arrData(), 2) ' Loop through the headers in your data
    bool = True
    Select Case arrData(1, i)
        Case "IBAN"
            lOutput = 0 ' Allows you to determine where the data will be put in your array
        Case "Arg2"
            lOutput = 1
        Case "Arg3"
            lOutput = 2
        Case Else
            bool = False
    End Select

    If bool = True Then
        For j = 1 to Ubound(arrData(), 1)
            arrOut(j - 1, lOutput) = arrData(j, i)
        Next
    End If
Next

这应该允许您从.CSV文件中选择某些数据并将其加载到数组中。然后,您可以根据需要将数据输出到范围。例如

With wsOutput
    Set r = .Range("A1").Resize(Ubound(arrOut(), 1) + 1, Ubound(arrOut(), 2) + 1)
    r.Value = arrOut()
End With

答案 1 :(得分:0)

以下代码使用ADODB在CSV文件上执行SQL查询,从而按照您希望的顺序仅导入所需的列。

Sub SQL_Extract()
    Dim objConnection           As Object
    Dim objRecordset            As Object
    Dim CSVFilename             As String
    Dim CSVFilepath             As String

    CSVFilename = "myCSVFile.csv"           ' Change to name of your CSV file
    CSVFilepath = "C:\Temp\DownloadFolder\" ' Change to location of CSV file

    ' Set up connections & dataset objects
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")    
    objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                   "Data Source=" & CSVFilepath & ";" & _
                                   "Extended Properties=""text;HDR=YES;FMT=CSVDelimited"";"
    objConnection.Open

    'Create the SQL command to retrieve information
    'The following assumes that the CSV file contains columns with headings of
    ' "IBAN", "Transaction Date" and "Amount".  (Any other columns in the file
    ' will be ignored.)
    sqlCommand = "SELECT [IBAN], " & _
                 "       [Transaction Date], " & _
                 "       [Amount] " & _
                 "FROM [" & CSVFilename & "]"
    'Execute the query
    objRecordset.Open sqlCommand, objConnection, 3, 3, 1

    If Not objRecordset.EOF Then ' Check whether any records were created by the query
        ' Write out the results of the query
        ' Change "A2" to top left cell of area where you want results written
        Range("A2").CopyFromRecordset objRecordset
    End If

    objRecordset.Close
    objConnection.Close
End Sub