Microsoft Access 掲示板

横ですが、これは運用を変えられないのでしょうか。
「今欲しがってるもの」→ExcelのピボットテーブルやAccessのクロス集計クエリ→「今あるもの」
なので、「今欲しがってるもの」をベースに変更できないのでしょうか。
メリットとして、商品を柔軟に増やせるなんてのもありますが。

「初心者なもの」の実際のところがよく分からないので、釈迦に説法だったらすみません。

ExcelやAccessは集計が得意です。しかし、集計後のデータから集計前を復元することは困難または不可能です。
My Car Bomberさんの例であれば、
今あるもの　→　今欲しいもの　への加工は苦手（機能を自分で作らないといけない）ですが、
今欲しいもの　→　今あるもの　への加工は得意（機能が用意されている）です。

My Car Bomberさんが例えば
依頼ID 依頼日 取引先ID 商品ID
などと入力するようにすれば、「今あるもの」がすぐに得られるだけでなく、
さまざまな区間（日、月、年他任意の区間）で集計がすぐに得られると思いますが、
切り替える価値がありそうか検討してみて下さい。
（依頼日を Date や CTRL + ; で入力できるし、他でも支援ができます）

エクセルの表のフォーマットがデータベースとしては扱いにくい形になってます。
データベース用語とて「正規化」ができていない状態です。
もし、エクセルの表の形式を変更できるならそれを検討してみてはどうでしょう。
banjoさんの回答も同じ意味だと思います。

もし、エクセルの表のフォーマットは変更不可ということなら、
表範囲に名前をつけることはできないでしょうか。
表範囲をテーブルにできないでしょうか。
(テーブルにすれば自動で名前がつきます。)

そうすれば、インポートするときにその名前を指定してインポートできます。

シートの形式を変更したり、シートを手作業で加工して名前を付けたりすることは出来ないという前提でお願いします。
そのため、任意の範囲のみをインポートする方法を模索しています。

正規化というのは、今回でいえば、A列と1～3行目が無ければ正規化できているということになりますか？

エクセルの方は変更できないということであれば、アクセスにインポートしてから、アクセスの方で正規化変換することになります。
Accessではレポートに出力するだけで、出力レイアウトがエクセルの表とほぼ同じということなら必要ないです。
ただ、せっかくアクセスにインポートするならデータベースとして活用したいですよね。
印刷だけなら、エクセルでもできますので。

シートの範囲指定してインポートするなら、TransferSpreadsheet で第6引数でシートや範囲を指定できます。

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "テーブル名", "Excelファイル名", False, "シート名$B4:I"

上記はB列からI列の４行目からデータのある最後までインポートします。

Function ImportOrderRecords(SourceBookPath As String, SourceSheetName As String)
On Error GoTo Err_ImportOrderRecords

    Const OrderDateCellAddress As String = "B2"
    Const OrderDateSuffix As String = "依頼分"
    Const HeaderRow As Long = 4
    Const KeyColumn As Long = 2
    Const DestinationTableName As String = "T_インポートテーブル"

    ImportOrderRecords = Null

    Dim xlsApp As Object        'Excel.Application
    Dim xlsBook As Object       'Excel.Workbook
    Dim xlsWorksheet As Object  'Excel.Worksheet

    Set xlsApp = CreateObject("Excel.Application")

    Set xlsBook = xlsApp.Workbooks.Open(FileName:=SourceBookPath, ReadOnly:=True)
    Set xlsWorksheet = xlsBook.Worksheets(SourceSheetName)

    Dim varOrderDate As Variant
    Dim lngSuffixPostion As Long

    With xlsWorksheet.Range(OrderDateCellAddress)
        
        varOrderDate = .Value
        lngSuffixPostion = InStrRev(varOrderDate, OrderDateSuffix, -1, vbTextCompare)
        
        If lngSuffixPostion > 0 Then
            varOrderDate = Trim(Left(varOrderDate, lngSuffixPostion - 1))
        End If
        
        If IsDate(varOrderDate) = True Then
            varOrderDate = CDate(varOrderDate)
        Else
            Debug.Print .Address(False, False) & " セルの値: "
            Debug.Print .Value
            MsgBox .Address(False, False) & " セルから依頼日を参照できません。", _
                   vbExclamation, _
                   "ImportOrderRecords"
            Set xlsWorksheet = Nothing
            xlsBook.Close False
            Set xlsBook = Nothing
            xlsApp.Quit
            Set xlsApp = Nothing
            Exit Function
        End If

    End With

    Dim lngFirstDataRow As Long
    Dim lngLastDataRow As Long

    With xlsWorksheet
        
        lngFirstDataRow = HeaderRow + 1
        lngLastDataRow = .Cells(.Rows.Count, KeyColumn).End(xlUp).Row
        
        If lngFirstDataRow > lngLastDataRow Then
            MsgBox "ワークシート[" & .Name & "]からデータ行を参照できません。", _
                   vbExclamation, _
                   "データ参照エラー (ImportOrderRecords)"
            Set xlsWorksheet = Nothing
            xlsBook.Close False
            Set xlsBook = Nothing
            xlsApp.Quit
            Set xlsApp = Nothing
            Exit Function
        End If
        
    End With

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String

    Set db = CurrentDb

    strSQL = "DELETE * FROM [" & DestinationTableName & "]"
    Debug.Print strSQL
    db.Execute strSQL, dbFailOnError

    strSQL = "SELECT * FROM [" & DestinationTableName & "]"
    Debug.Print strSQL

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

    Dim lngDataRow As Long
    Dim lngInsertCount As Long

    For lngDataRow = lngFirstDataRow To lngLastDataRow
        rs.AddNew
        rs![依頼日].Value = varOrderDate
        With xlsWorksheet.Cells(lngDataRow, KeyColumn)
            rs![社名ID].Value = .Value
            rs![商品名1].Value = .Offset(0, 4).Value
            rs![商品名2].Value = .Offset(0, 5).Value
            rs![商品名3].Value = .Offset(0, 6).Value
            rs![商品名4].Value = .Offset(0, 7).Value
        End With
        rs.Update
        lngInsertCount = lngInsertCount + 1
        Debug.Print lngInsertCount & " 件目のレコードを取り込みました。"
    Next

    ImportOrderRecords = lngInsertCount

Exit_ImportOrderRecords:
On Error Resume Next

    Set rs = Nothing
    Set db = Nothing

    Set xlsWorksheet = Nothing

    If Not xlsBook Is Nothing Then
        xlsBook.Close False
        Set xlsBook = Nothing
    End If

    If Not xlsApp Is Nothing Then
        xlsApp.Quit
        Set xlsApp = Nothing
    End If

    Exit Function

Err_ImportOrderRecords:

    Dim strErrMsg As String

    strErrMsg = Err.Number & ": " & Err.Description

    MsgBox strErrMsg, _
           vbCritical, _
           "実行時エラー (ImportOrderRecords)"

    Resume Exit_ImportOrderRecords
End Function