■

Sub 読み込みと削除()

    Dim FilePass    As Variant
    Dim FileName    As String
    Dim ShCount     As Long

    ShCount = ThisWorkbook.Worksheets.Count 'VBAの書かれたファイルのシート数
    
    'ダイアログを開いてファイルを指定
    FilePass = Application.GetOpenFilename("Excelブック,*.xlsx,Excelマクロ,*.xlsm,テキスト,*.txt")
    
    If FilePass <> "False" Then
    
        FileName = Dir(FilePass) 'ファイル名を取得
    
        Workbooks.Open FilePass 'ファイルを開く
        
        Worksheets(1).Copy Before:=ThisWorkbook.Worksheets(1) '一番最初に追加
    
        Workbooks(FileName).Close savechanges:=False
        
        ActiveSheet.Name = "データ" '読み込んだシート名を変更する
        
Dim ii As Long, keyWord
     Const StartCol As Long = 1, myRow As Long = 1
     keyWord = Array("ASIN", "名", "タイトル", "SKU", "注文された商品")
     If IsArray(keyWord) Then keyWord = Join(keyWord, "|")
     With CreateObject("VBScript.RegExp")
         .Pattern = keyWord
         For ii = Cells(myRow, Columns.Count).End(xlToLeft).Column To StartCol + 1 Step -1
             If Not .test(Cells(myRow, ii).Value) Then Columns(ii).Delete
         Next
     End With
    End If
    
    Dim x As Variant
    Dim c As Range
    Dim cols As Long

    With Sheets("データ")
        'シート１の列数取得
        cols = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    With Sheets("商品コード一覧")
        'シート２のC1からC列のデータ最終行までのセルを１つずつ取り出す
        For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))
            'その値でシート１のB列をMach検索
            x = Application.Match(c.Value, Sheets("データ").Columns("B"), 0)
            If IsNumeric(x) Then    'もしあれば
                '１行分を転記
                c.Offset(, 4).Value = Sheets("データ").Cells(x, "E").Value
            End If
        Next
    End With
    Worksheets("★使い方★").Activate
    MsgBox FileName & "の転記完了!"
End Sub
 Sub 行削除()
     Dim ii As Long, keyWord
     Const StartCol As Long = 1, myRow As Long = 1
     keyWord = Array("ASIN", "タイトル", "SKU", "注文された商品数")
     If IsArray(keyWord) Then keyWord = Join(keyWord, "|")
     With CreateObject("VBScript.RegExp")
         .Pattern = keyWord
         For ii = Cells(myRow, Columns.Count).End(xlToLeft).Column To StartCol + 1 Step -1
             If Not .test(Cells(myRow, ii).Value) Then Columns(ii).Delete
         Next
     End With
 End Sub
 Sub Sample()
    Dim x As Variant
    Dim c As Range
    Dim cols As Long

    With Sheets("データ")
        'シート１の列数取得
        cols = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    With Sheets("商品コード一覧")
        'シート２のC1からC列のデータ最終行までのセルを１つずつ取り出す
        For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))
            'その値でシート１のB列をMach検索
            x = Application.Match(c.Value, Sheets("データ").Columns("B"), 0)
            If IsNumeric(x) Then    'もしあれば
                '１行分を転記
                c.Offset(, 4).Value = Sheets("データ").Cells(x, "E").Value
            End If
        Next
    End With
    MsgBox "転記終了"
 End Sub
 Sub データシート削除()
 Worksheets("データ").Delete ' シート「Sheet1」を削除
 End Sub
Sub 数値入力()
Dim hensu As Variant
hensu = Application.InputBox(prompt:="登録したい売上月を入力してください（例：1月→1)", _
                                Title:="数値入力", _
                                Type:=1)
c = Rows(1).Find(hensu & "月").Column
MsgBox c

End Sub
Sub test()

c = Rows(1).Find("12月", LookAt:=xlWhole).Column
MsgBox c
End Sub

Sub 対象領域をコピーして貼り付ける()
Worksheets("商品コード一覧").Activate
Dim hensu As Variant
hensu = Application.InputBox(prompt:="登録したい売上月を入力してください（例：1月→1)", _
                                Title:="数値入力", _
                                Type:=1)
c = Sheets("商品コード一覧").Rows(1).Find(hensu & "月", LookAt:=xlWhole).Column
    Dim lastrow As Integer
        With Worksheets("商品コード一覧")
          lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
          .Range(Cells(2, 7), Cells(lastrow, 7)).Copy
          .Cells(2, c).PasteSpecial Paste:=xlPasteValues
        End With
    Application.CutCopyMode = False
    With Worksheets("商品コード一覧")
          .Range(Cells(2, 7), Cells(lastrow, 7)).Clear
        End With
        Worksheets("★使い方★").Activate
End Sub