Question

我正在编写一个脚本，将扫描电子显微镜的csv文件输出导入到按日期和样本编号组织的主电子表格中。之前从未使用过vba，并且在此之前只有很少的编程经验，这一直是一个相当大的挑战。按样本和图像编号组织了几千个文件。现在我所拥有的能够读取csv文件并将它们复制到单个电子表格中。 csv文件看起来像这样

Atomic number,Element symbol,Element name,Concentration percentage,Certainty
8,O,Oxygen,57.5,0.99
14,Si,Silicon,15.5,0.99
26,Fe,Iron,13.6,0.97
13,Al,Aluminium,8.4,0.98
19,K,Potassium,3.3,0.97
22,Ti,Titanium,0.9,0.89
65,Tb,Terbium,0.7,0.53

当我运行我的代码时，上述数据将从每个文件中复制并粘贴到主电子表格中。我想做的是让它格式化这些数据。以下是我到目前为止实际将数据写入电子表格的内容。

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#Else
    Private Declare Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#End If


Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub


Sub Merge_CSV_Files()
    Dim BatFileName As String
    Dim TXTFileName As String
    Dim XLSFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim DefPath As String
    Dim Wb As Workbook
    Dim oApp As Object
    Dim oFolder
    Dim foldername

    BatFileName = Environ("Temp") & _
            "\CollectCSVData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat"
    TXTFileName = Environ("Temp") & _
            "\AllCSV" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt"

    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        FileExtStr = ".xlsx": FileFormatNum = 51
        'FileExtStr = ".xls": FileFormatNum = 56
    End If

    XLSFileName = DefPath & "SEM Master File" & _
                  Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr

    Set oApp = CreateObject("Shell.Application")
    Set oFolder = oApp.BrowseForFolder(0, "Select folder with CSV files", 512)
    If Not oFolder Is Nothing Then
        foldername = oFolder.Self.Path
        If Right(foldername, 1) <> "\" Then
            foldername = foldername & "\"
        End If

        Open BatFileName For Output As #1
        Print #1, "Copy " & Chr(34) & foldername & "*.csv" _
                & Chr(34) & " " & TXTFileName
        Close #1

        ShellAndWait BatFileName, 0
        If Dir(TXTFileName) = "" Then
            MsgBox "There are no csv files in this folder"
            Kill BatFileName
            Exit Sub
        End If

        Application.ScreenUpdating = False
        Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
                :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
                Space:=False, Other:=False, AdjustColumnWidth = True

        Set Wb = ActiveWorkbook
        Application.DisplayAlerts = False
        Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
        Application.DisplayAlerts = True

        Wb.Close savechanges:=False
        MsgBox "You will find the Excel file here: " & vbNewLine & XLSFileName

        Kill BatFileName
        Kill TXTFileName

        Application.ScreenUpdating = True
    End If
End Sub

每个文件的名称是其样本/图像编号和日期。我需要的是忽略每个csv文件中的第一行数据（原子序号，元素符号等），在包含这些标签的工作表顶部创建一个受保护的行，并记录每个将文件放在该文件的每行数据旁边的列中。记录下这些信息后，我想我将能够按照我想要的方式组织数据。

Answer 1

使用ADO查看此方法。改编自：https://msdn.microsoft.com/en-us/library/ms974559.aspx

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")

strPathtoTextFile = "C:\Databases\"

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & strPathtoTextFile & ";" & _
      "Extended Properties=""text;HDR=YES;FMT=Delimited"""

objRecordset.Open "SELECT * FROM MyCSV.csv where [Atomic number] <> "Atomic number"", _
      objConnection, adOpenStatic, adLockOptimistic, adCmdText

Range("A2").CopyFromRecordset objRecordset
objRecordset.close
objConnection.close

将从csv文件导入的数据格式化为excel电子表格

1 个答案: