自己已解决:交叉2DExcel表格如何导入到Access数据表中

经过自己的努力,终于解决了,先把源代码贴上,给大家共享,与大家一起进步

Dim db2 As New ADODB.Connection
Dim rs2 As New ADODB.Recordset
Dim nSheetCount As Integer
Dim i As Integer
Dim AAA As Integer
Dim BBB As Integer

Dim sArrFieldsName

Sub 数据导入()

    db2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & CurrentProject.Path & "\test.mdb"
    db2.Open

    Dim NewXls As Excel.Application
    Dim NewBook As Excel.Workbook
    Dim NewSheet As Excel.Worksheet
    '
    Set NewXls = New Excel.Application    '创建 EXCEL 应用程序，打开 EXCEL2000
    Set NewBook = NewXls.Workbooks.Open(CurrentProject.Path & "\Demo.xls")  '创建工作簿
    nSheetCount = NewBook.Worksheets.Count

    sArrFieldsName = Array("尺码", "颜色", "数量")

    Set rs2 = Nothing
    rs2.CursorLocation = adUseClient
    rs2.Open "select * from 1 ", db2, adOpenStatic, adLockPessimistic

    Set NewSheet = NewBook.Worksheets(1)  '创建工作表

    For AAA = 2 To 10    '尺码行数

        For BBB = 1 To 6  '颜色列数
            If NewSheet.Cells(AAA + 1, 1) <> "" Then
            If NewSheet.Cells(2, BBB + 1) <> "" Then
           If Nz(NewSheet.Cells(AAA + 1, BBB + 1)) <> 0 Then
            rs2.AddNew
           
            rs2!尺码 = NewSheet.Cells(AAA + 1, 1).Value
            rs2!颜色 = NewSheet.Cells(2, BBB + 1).Value
            rs2!数量 = NewSheet.Cells(AAA + 1, BBB + 1).Value
        End If
        End If
        End If
        Next
    Next
  
    rs2.Update

    NewXls.Quit
    db2.Close

End Sub