文章摘要
本文描述了一段VBA代码，用于从Excel工作簿中提取和处理数据，并生成一个CSV文件。代码的主要功能包括：
1. **初始化和文件路径设置**：通过`str_file_path`和`str_new_file_path`变量指定输入和输出文件路径，并使用`checkAndAttachWorkbook`函数打开输入工作簿。
2. **数据提取和处理**：
- 从输入工作表中提取数据，并使用`CreateObject("Scripting.Dictionary")`创建一个字典来存储公司名称和缩写。
- 删除重复数据并整理数据结构，将数据写入新的输出工作表。
3. **数据转换和输出**：将处理后的数据写入CSV格式，并在输出文件中添加额外的列（如“C_col”到“H_col”）以存储额外信息。
代码通过`getLastValidRow`辅助函数获取工作表的最后有效行，并使用`checkAndCloseWorkbook`函数完成对工作簿的检查和关闭操作。
总结：该代码实现了从Excel提取数据、处理去重并写入CSV文件的功能。
Option Base 1
Option Explicit
Sub main()
On Error GoTo error_handling
Dim wb As Workbook
Dim wb_out As Workbook
Dim sht As Worksheet
Dim sht_out As Worksheet
Dim rng As Range
Dim usedrows As Byte
Dim usedrows_out As Byte
Dim dict_cnum_company As Object
Dim str_file_path As String
Dim str_new_file_path As String
‘assign values to variables:
str_file_path=”C:\Users\12078\Desktop\Python\CNUM_COMPANY.csv”
str_new_file_path=”C:\Users\12078\Desktop\Python\CNUM_COMPANY_OUTPUT.csv”
Set wb=checkAndAttachWorkbook(str_file_path)
Set sht=wb.Worksheets(“CNUM_COMPANY”)
Set wb_out=Workbooks.Add
wb_out.SaveAs str_new_file_path, xlCSV ‘create a csv file
Set sht_out=wb_out.Worksheets(“CNUM_COMPANY_OUTPUT”)
Set dict_cnum_company=CreateObject(“Scripting.Dictionary”)
usedrows=WorksheetFunction.Max(getLastValidRow(sht, “A”), getLastValidRow(sht, “B”))
‘rename the header ‘COMPANY’ to ‘Company_New’,remove blank & duplicate lines/rows.
Dim cnum_company As String
cnum_company=””
For Each rng In sht.Range(“A1”, “A” & usedrows)
If VBA.Trim(rng.Offset(0, 1).Value)=”COMPANY” Then
rng.Offset(0, 1).Value=”Company_New”
End If
cnum_company=rng.Value & “-” & rng.Offset(0, 1).Value
If VBA.Trim(cnum_company) <> “-” And Not dict_cnum_company.Exists(rng.Value & “-” & rng.Offset(0, 1).Value) Then
dict_cnum_company.Add rng.Value & “-” & rng.Offset(0, 1).Value, “”
End If
Next rng
‘loop the keys of dict split the keyes by ‘-‘ into cnum array and company array.
Dim index_dict As Byte
Dim arr_cnum()
Dim arr_Company()
For index_dict=0 To UBound(dict_cnum_company.keys)
ReDim Preserve arr_cnum(1 To UBound(dict_cnum_company.keys) + 1)
ReDim Preserve arr_Company(1 To UBound(dict_cnum_company.keys) + 1)
arr_cnum(index_dict + 1)=Split(dict_cnum_company.keys()(index_dict), “-“)(0)
arr_Company(index_dict + 1)=Split(dict_cnum_company.keys()(index_dict), “-“)(1)
Debug.Print index_dict
Next
‘assigns the value of the arrays to the celles.
sht_out.Range(“A1”, “A” & UBound(arr_cnum))=Application.WorksheetFunction.Transpose(arr_cnum)
sht_out.Range(“B1”, “B” & UBound(arr_Company))=Application.WorksheetFunction.Transpose(arr_Company)
‘add 6 columns to output csv file:
Dim arr_columns() As Variant
arr_columns=Array(“C_col”, “D_col”, “E_col”, “F_col”, “G_col”, “H_col”) ‘
sht_out.Range(“C1:H1”)=arr_columns
Call checkAndCloseWorkbook(str_file_path, False)
Call checkAndCloseWorkbook(str_new_file_path, True)
Exit Sub
error_handling:
Call checkAndCloseWorkbook(str_file_path, False)
Call checkAndCloseWorkbook(str_new_file_path, False)
End Sub
‘ 辅助函数：
‘Get last row of Column N in a Worksheet
Function getLastValidRow(in_ws As Worksheet, in_col As String)
getLastValidRow=in_ws.Cells(in_ws.Rows.count, in_col).End(xlUp).Row
End Function
Function checkAndAttachWorkbook(in_wb_path As String) As Workbook
Dim wb As Workbook
Dim mywb As String
mywb=in_wb_path
For Each wb In Workbooks
If LCase(wb.FullName)=LCase(mywb) Then
Set checkAndAttachWorkbook=wb
Exit Function
End If
Next
Set wb=Workbooks.Open(in_wb_path, UpdateLinks:=0)
Set checkAndAttachWorkbook=wb
End Function
Function checkAndCloseWorkbook(in_wb_path As String, in_saved As Boolean)
Dim wb As Workbook
Dim mywb As String
mywb=in_wb_path
For Each wb In Workbooks
If LCase(wb.FullName)=LCase(mywb) Then
wb.Close savechanges:=in_saved
Exit Function
End If
Next
End Function