エクセルのマクロを教えてください

Question

M列からZ列までのデータがあります。
A1セルにリンゴと入れるとM列からリンゴを探して
B列にA列と合致したN列の値を返す。
この時に昇順に並び替える。
次にC1セルに長野01と入れると同様にN列から長野01を探して
D列に合致したO列の値を返す。
そして昇順に並び替える

この様なことを繰り返したいです。
コードを教えてください。

tom04 · Accepted Answer

こんばんは！

画像の配置だとして・・・
一例です。
Changeイベントにしていますので、シートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long
    If Intersect(Target, Range("A1,C1")) Is Nothing Or Target.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        With Target
            If .Value <> "" Then
            If .Column = 1 Then
                Range("B:B").ClearContents
                lastRow = Cells(Rows.Count, "M").End(xlUp).Row
                Range("M:M").AutoFilter field:=1, Criteria1:=.Value
                If Cells(Rows.Count, "M").End(xlUp).Row > 1 Then
                    Range(Cells(2, "N"), Cells(lastRow, "N")).SpecialCells(xlCellTypeVisible).Copy .Offset(, 1)
                    ActiveSheet.AutoFilterMode = False
                    Range("B:B").Sort key1:=Range("B1"), order1:=xlAscending, Header:=xlNo
                Else
                    .Select
                    MsgBox "該当データなし"
                End If
            Else
                Range("D:D").ClearContents
                lastRow = Cells(Rows.Count, "N").End(xlUp).Row
                Range("N:N").AutoFilter field:=1, Criteria1:=.Value
                If Cells(Rows.Count, "N").End(xlUp).Row > 1 Then
                    Range(Cells(2, "O"), Cells(lastRow, "O")).SpecialCells(xlCellTypeVisible).Copy .Offset(, 1)
                    ActiveSheet.AutoFilterMode = False
                    Range("D:D").Sort key1:=Range("D1"), order1:=xlAscending, Header:=xlNo
                Else
                    .Select
                    MsgBox "該当データなし"
                End If
            End If
            End If
        End With
            ActiveSheet.AutoFilterMode = False
            Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

WindFaller · Answer

こんばんは。

比較的、面白いものができましたので、紹介します。

配置をちょっとずらせまして、添付画像のようにしてみますと、もう、Excelの既存の機能をそのまま使えます。それに、ちょっとマクロを付けただけです。

なお、元のデータの範囲は、名前の定義で「データ」と付けました。
ボタンは、フォームコントロールです。

長野01, 02 の場合は、＊(アスタリスク)を使い、「長野*」とします。

'標準モジュール
Sub DataOut1()
'ボタン1
　　If Range("A2").Value = "" Then Exit Sub
　　Range("データ").AdvancedFilter Action:=xlFilterCopy, _
　　CriteriaRange:=Range("A1", Cells(20, "A").End(xlUp)), _
　　CopyToRange:=Range("B1"), Unique:=False
End Sub
Sub DataOut2()
'ボタン2
　　If Range("C2").Value = "" Then Exit Sub
　　Range("データ").AdvancedFilter Action:=xlFilterCopy, _
　　CriteriaRange:=Range("C1", Cells(20, "C").End(xlUp)), _
　　CopyToRange:=Range("D1"), Unique:=False
End Sub

エクセルのマクロを教えてください

こんばんは！

こんばんは。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング