0
我正在編寫一個腳本,它將從掃描電子顯微鏡導入csv文件輸出到由日期和樣本編號組織的主電子表格。以前從未使用過vba,而且之前幾乎沒有編程經驗,這是一個相當大的挑戰。有幾千個文件按樣本和圖片編號組織。現在我所擁有的能夠讀取csv文件並將它們複製到一個電子表格中。該CSV文件看起來像這樣格式化從csv文件導入Excel電子表格的數據
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文件中的第一行數據(原子序號,元素符號等),在包含這些標籤的工作表頂部創建一個受保護的行,並記錄每個文件放在該文件每行數據旁邊的列中。記錄這些信息後,我認爲我可以按照自己想要的方式組織數據。