-1
2つの独立したマクロを実行し、2つの別々のファイルを生成するExcelブロック内に2つのコードブロックがあります。私はコードの最初の部分を実行する1つのマクロをし、2番目のセクションをファイルを引き継ぎ、そのことを行い、ファイルを生成します。2つのExcelマクロを1つにする必要があります
最初のマクロは、多くのTXTファイルを1つにまとめます。
2番目のマクロは、列構造をデータベースに合わせて変更します。
最終的な目標は、フォーマット済みの.xlsxファイルをどこかに保存することです。ここで
はコードの私の最初の部分である：ここでは
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
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub
Sub Merge_TXT_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
'Create two temporary file names
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"
'Folder where you want to save the Excel file
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Set the extension and file format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007 or higher
FileExtStr = ".xlsx": FileFormatNum = 51
'If you want to save as xls(97-2003 format) in 2007 use
'FileExtStr = ".xls": FileFormatNum = 56
End If
'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr
'Browse to the folder with CSV files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with .TXT files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If
'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*.txt" _
& Chr(34) & " " & TXTFileName
Close #1
'Run the Bat file to collect all data from the CSV files into a TXT file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no csv files in this folder"
Kill BatFileName
Exit Sub
End If
'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=False, Other:=False
'Save text file as a Excel file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
Application.DisplayAlerts = True
Wb.Close savechanges:=False
MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName
'Delete the bat and text file you temporary used
Kill BatFileName
Kill TXTFileName
Application.ScreenUpdating = True
End If
End Sub
は、第二のコードです：
Sub Edge_Filer_Convertor()
' MoveColumns Macro
Dim iRow As Long
Dim iCol As Long
'Constant values
data_sheet1 = "Sheet1"
target_sheet = "Reorganized_Edge_EDD" 'Specify the sheet to store the results
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use
'Create a new sheet to store the results
Worksheets.Add.Name = "Reorganized_Edge_EDD"
'Start organizing columns
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count
'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns
targetCol = 0
'Read the header of the original sheet to determine the column order
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sample Type" Then targetCol = 5
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sample Matrix" Then targetCol = 8
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sample Identification" Then targetCol = 14
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sample Date" Then targetCol = 15
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sample Time" Then targetCol = 16
If Sheets(data_sheet1).Cells(1, iCol).Value = "Report Number/Sample Group Identifier" Then targetCol = 18
If Sheets(data_sheet1).Cells(1, iCol).Value = "Primary Laboratory Identification" Then targetCol = 19
If Sheets(data_sheet1).Cells(1, iCol).Value = "Secondary Laboratory Identification" Then targetCol = 20
If Sheets(data_sheet1).Cells(1, iCol).Value = "Date Laboratory Received" Then targetCol = 21
If Sheets(data_sheet1).Cells(1, iCol).Value = "Time Laboratory Received" Then targetCol = 22
If Sheets(data_sheet1).Cells(1, iCol).Value = "Laboratory Report Date" Then targetCol = 23
If Sheets(data_sheet1).Cells(1, iCol).Value = "CAS Identification Number" Then targetCol = 24
If Sheets(data_sheet1).Cells(1, iCol).Value = "Analysis" Then targetCol = 25
If Sheets(data_sheet1).Cells(1, iCol).Value = "Result" Then targetCol = 26
If Sheets(data_sheet1).Cells(1, iCol).Value = "LOQ" Then targetCol = 27
If Sheets(data_sheet1).Cells(1, iCol).Value = "LOD" Then targetCol = 28
If Sheets(data_sheet1).Cells(1, iCol).Value = "DL" Then targetCol = 29
If Sheets(data_sheet1).Cells(1, iCol).Value = "Qualifier" Then targetCol = 30
If Sheets(data_sheet1).Cells(1, iCol).Value = "Units" Then targetCol = 31
If Sheets(data_sheet1).Cells(1, iCol).Value = "Date Analyzed" Then targetCol = 32
If Sheets(data_sheet1).Cells(1, iCol).Value = "Analyst" Then targetCol = 33
If Sheets(data_sheet1).Cells(1, iCol).Value = "Batch Identification" Then targetCol = 34
If Sheets(data_sheet1).Cells(1, iCol).Value = "Extraction Method" Then targetCol = 35
If Sheets(data_sheet1).Cells(1, iCol).Value = "Preparation Method" Then targetCol = 36
If Sheets(data_sheet1).Cells(1, iCol).Value = "Preparation Date" Then targetCol = 37
If Sheets(data_sheet1).Cells(1, iCol).Value = "Preparer Initials" Then targetCol = 38
If Sheets(data_sheet1).Cells(1, iCol).Value = "Spike Value" Then targetCol = 39
If Sheets(data_sheet1).Cells(1, iCol).Value = "Spike Reference Value" Then targetCol = 40
If Sheets(data_sheet1).Cells(1, iCol).Value = "Low Limit" Then targetCol = 42
If Sheets(data_sheet1).Cells(1, iCol).Value = "High Limit" Then targetCol = 43
If Sheets(data_sheet1).Cells(1, iCol).Value = "Run Number" Then targetCol = 46
If Sheets(data_sheet1).Cells(1, iCol).Value = "Sequence Number" Then targetCol = 47
If Sheets(data_sheet1).Cells(1, iCol).Value = "Duplicate Result" Then targetCol = 48
If Sheets(data_sheet1).Cells(1, iCol).Value = "Dilution Factor" Then targetCol = 49
If Sheets(data_sheet1).Cells(1, iCol).Value = "MSD Result" Then targetCol = 50
If Sheets(data_sheet1).Cells(1, iCol).Value = "QC Qualifier" Then targetCol = 51
If Sheets(data_sheet1).Cells(1, iCol).Value = "Comments" Then targetCol = 52
'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot
If targetCol <> 0 Then
'Select the column and copy it
Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, targetCol)
'Add Correct Headers
Range("A1") = "Request_Number"
Range("B1") = "Request_Date"
Range("C1") = "Authorized_By"
Range("D1") = "Sample_Field_Type_Composite_or_Grab"
Range("E1") = "Sample_Laboratory_Type"
Range("F1") = "WAD_Number"
Range("G1") = "Profile_Number"
Range("H1") = "Sample_Matrix"
Range("I1") = "Sample_Description"
Range("J1") = "Site_of_Generation"
Range("K1") = "Source_Process_Generation"
Range("L1") = "Program"
Range("M1") = "Laboratory_ID_Number"
Range("N1") = "Sample_Identification"
Range("O1") = "Sample_Date"
Range("P1") = "Sample_Time"
Range("Q1") = "Sampled_By"
Range("R1") = "Report_Number_or_Work_Order_Number"
Range("S1") = "Primary_Laboratory_Identification"
Range("T1") = "Secondary_Laboratory_Identification"
Range("U1") = "Date_Laboratory_Received"
Range("V1") = "Time_Laboratory_Received"
Range("W1") = "Laboratory_Report_Date"
Range("X1") = "CAS_Identification_Number"
Range("Y1") = "Analysis"
Range("Z1") = "Result"
Range("AA1") = "LOQ"
Range("AB1") = "LOD"
Range("AC1") = "DL"
Range("AD1") = "Qualifier"
Range("AE1") = "Units"
Range("AF1") = "Date_Analyzed"
Range("AG1") = "Analyst"
Range("AH1") = "Batch_Identification"
Range("AI1") = "Extraction_Method"
Range("AJ1") = "Preparation_Method"
Range("AK1") = "Preparation_Date"
Range("AL1") = "Preparer_Initials"
Range("AM1") = "Spike_Value"
Range("AN1") = "Spike_Reference_Value"
Range("AO1") = "Percent_Recovered"
Range("AP1") = "Low_Limit"
Range("AQ1") = "High_Limit"
Range("AR1") = "RPD_Reference_Value"
Range("AS1") = "RPD_Limit"
Range("AT1") = "Run_Number"
Range("AU1") = "Sequence_Number"
Range("AV1") = "Duplicate_Result"
Range("AW1") = "Dilution_Factor"
Range("AX1") = "MSD_Result"
Range("AY1") = "QC_Qualifier"
Range("AZ1") = "Comments"
'Change data type to match database
Columns("A:AZ").Select
Selection.NumberFormat = "@"
Range("B:B,O:O,U:U,W:W,AF:AF,AK:AK").Select
Selection.NumberFormat = "m/d/yyyy"
Range("P:P,V:V").Select
Selection.NumberFormat = "h:mm;@"
End If
Next iCol 'Move to the next column until all columns are read
End Sub