如何通过MS-Access使用VBA从多个excel表中的每个单元格保存/应用数据类型到合并的excel表?

Question

在MS Access中，我使用VBA迭代多个Excel工作表，然后根据共享连接键"唯一事务id"在5个工作表上执行左连接。合并后，我将其保存到Excel文件的末尾。现在我有了这5张表格的合并。问题是我需要保留/应用或至少能够引用以前工作表的数据类型。

我尝试做的是在执行左连接之后，然后创建一个引用工作表的所有正确范围并应用在那里找到的数据类型的字典。但这不起作用，因为它似乎只是假设一种数据类型并将其应用于列。一列中可能有许多不同的数据类型，我需要一种细粒度的方式将数据类型应用于合并的工作表，或者一种方法以正确的方向引用以前的工作表，以设置合并的工作表。

这是我试过的。这是表格的左连接代码，我尝试使用字典来应用数据类型:

Dim ls_last_row As Long
Dim cs_last_row As Long
Dim e_sheet_last_row As Long
Dim p_sheet_last_row As Long

Set ls = objFile.Worksheets("2. sheet")
Set cs = objFile.Worksheets("3. sheet")
Set es = objFile.Worksheets("4. sheet")
Set ps = objFile.Worksheets("5. sheet")

l_sheet_last_row = ls.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
cs_last_row = cs.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
e_sheet_last_row = es.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
p_sheet_last_row = ps.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row

' loading in sheet2 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet2", filePath, True, "2. sheet!A1:AU" & loan_sheet_last_row
' loading in sheet3 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet3", filePath, True, "3. sheet!A1:I" & cs_last_row
' loading in sheet4 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet4", filePath, True, "4. sheet!A1:H" & e_sheet_last_row
' loading in shset5 to ms-access table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tmp_sheet5", filePath, True, "5. sheet!A1:D" & p_sheet_last_row

'Execute SQL statement to perform the join
Dim strSql As String
strSql = "SELECT sheet2.*, sheet3.*, sheet4.*, sheet5.* " _
& "FROM ((tmp_sheet2 AS sheet2 " _
& "LEFT JOIN tmp_sheet3 AS sheet3 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet3.[Unique Transaction ID])) " _
& "LEFT JOIN tmp_sheet4 AS sheet4 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet4.[Unique Transaction ID])) " _
& "LEFT JOIN tmp_sheet5 AS sheet5 ON CSTR(sheet2.[Unique Transaction ID]) = CSTR(sheet5.[Unique Transaction ID])"

'Create new table with join results
DoCmd.SetWarnings False
Dim tableName As String
tableName = "joined_table"
DoCmd.RunSQL "SELECT * INTO " & tableName & " FROM (" & strSql & ")"

DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet3_Unique Transaction ID]"
DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet4_Unique Transaction ID]"
DoCmd.RunSQL "ALTER TABLE joined_table DROP COLUMN [sheet5_Unique Transaction ID]"

'Add joined_table to ms-access
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & tableName)

Set newSheet = objFile.Worksheets.Add(After:=objFile.Worksheets(objFile.Worksheets.Count))
newSheet.Name = "2. Transaction Data"

' Copy header names to new sheet
Dim headerRange As Range
Dim i As Integer
Set headerRange = newSheet.Range("A1")
For i = 0 To rs.Fields.Count - 1
If i = 0 Then
headerRange.Offset(0, i) = "Unique Transaction ID"
Else
headerRange.Offset(0, i) = rs.Fields(i).Name
End If
Next i

' Copy data to new sheet
headerRange.Offset(1, 0).CopyFromRecordset rs

' create dictionary to store row numbers for IDs in Sheet 2
Dim idDict As Object
Set idDict = CreateObject("Scripting.Dictionary")
For i = 2 To loan_sheet_last_row
idDict.Add ls.Cells(i, 1).Value, i
Next i

' iterate sheet 2, store its data types and apply to newSheet
Dim j As Long
For i = 2 To loan_sheet_last_row
Dim id As Variant
id = ls.Cells(i, 1).Value ' assume ID is in column 1
Dim matchRow As Variant
If idDict.Exists(id) Then
Dim rowNumber As Long
rowNumber = idDict(id)
For j = 1 To 47 'iterate from column B to AU (2 to 47)
Dim dataType As String
dataType = TypeName(ls.Cells(i, j).Value)
newSheet.Cells(rowNumber, j).NumberFormat = GetNumberFormat(dataType)
Next j
End If
Next i

' iterate Sheet3, store its data types and apply to newSheet
Dim k As Long
For i = 2 To cs_last_row ' start from row 2 to skip header
id = cs.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For k = 2 To 9 ' iterate from colum B to column I
dataType = TypeName(cs.Cells(i, k).Value)
newSheet.Cells(rowNumber, k + 46).NumberFormat = GetNumberFormat(dataType)
Next k
End If
Next i

' iterate Sheet4, store its data types and apply to newSheet
Dim q As Long
For i = 2 To e_sheet_last_row ' start from row 2 to skip header
id = es.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For q = 2 To 8 ' iterate from column B to column H
dataType = TypeName(es.Cells(i, q).Value)
newSheet.Cells(rowNumber, q + 54).NumberFormat = GetNumberFormat(dataType)
Next q
End If
Next i

' iterate Sheet5, store its data types and apply to newSheet
Dim p As Long
For i = 2 To p_sheet_last_row ' start from row 2 to skip header
id = ps.Cells(i, 1).Value ' assuming ID is in column 1
If idDict.Exists(id) Then
rowNumber = idDict(id)
For p = 2 To 4 ' iterate from column B to column D
dataType = TypeName(ps.Cells(i, p).Value)
newSheet.Cells(rowNumber, p + 61).NumberFormat = GetNumberFormat(dataType)
Next p
End If
Next i

rs.Close
Set rs = Nothing

下面是GetNumberFormat方法:

Function GetNumberFormat(dataType As String) As String
'**********************************************************************
' Listed below is Excel's data types and VBA's NumberFormat equivalent
' General: General
' Number: 0
' Currency:    $#,##0.00;[Red]$#,##0.00
' Accounting:  _($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_)
' Date: m/d/yyyy
' Time:        [$-F400]h:mm:ss am/pm
' Percentage:  0.00%
' Fraction:    # ?/?
' Scientific: 0#
' String:        @
' Special:     ;;
' Custom:      #,##0_);[Red](#,##0)
'**********************************************************************
Select Case dataType
Case "String"
GetNumberFormat = "@"
Case "Date"
GetNumberFormat = "m/d/yyyy"
Case "Currency"
GetNumberFormat = "$#,##0.00;[Red]$#,##0.00"
Case "Double"
GetNumberFormat = "0"
Case "Integer"
GetNumberFormat = "0"
Case "Accounting"
GetNumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* " - "??_);_(@_)"
Case "Percentage"
GetNumberFormat = "0.00%"
Case Else
GetNumberFormat = "General"
End Select
End Function

我尝试张贴。我们期望保留每个单元格的数据类型，但是根据VBA遇到的第一个数据类型，每个列都默认为特定类型。需要一种方法来确保每个单元格的数据类型被保留。

Answer 1

我最好的建议是使用VBA来"擦洗"工作表，以便访问导入将接受混合数据列。以下是在小范围内修改带有撇号前缀的数字/日期值的快速测试示例，以便将其视为字符串。

Sub FixData()
Dim c As Range
For Each c In Range("A1:A25")
c.Value = "'" & c.Value
Next
End Sub