1354853314 入金確認するための、行列関係のエクセルマクロをつくってください!




【概要】
やりたいことは、2つのシートにある金額を比較して、一致したら、その行同士に存在する名前を検索、
その結果を成功なら結果シートに、失敗なら結果シート2に出力していくというものです。


詳細は画像と、下記追記しますので、ご確認ください。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/12/07 13:08:34
  • 終了:2012/12/11 02:24:11
id:naranara19

【詳細】
シートは4つあります。
まとめシートと、原本、結果シート、結果シート2というものです。
詳しくは添付画像をご確認ください。







【まとめシート】 (いずれも1行目は見出しです )
A,B,C,F,G-Lまで
名前, 金額 ,固有ID, 検索ワード,名前の候補


【原本シート】
D列,F 列,G列 ,AI列
固有 ID,名前漢字, 名前カナ ,金額

となっています。



【検索順序と結果ルール】 (行の範囲によって検索方法が少し違います )

【 2-300行までは】
1・まとめシート C列の固有ID を原本シート D2から下に向かってセルが空白になるまで検索し、一致した場合下記のように比べます。



<固有ID一致による金額比較>(まとめシート1行~300行目迄の処理)
まとめシートの同じ行の B列(金額)
↑比較↓
原本シートでヒットした行の AI列(金額)



【検索後の処理(ヒットしたとき)】
結果シートにまとめシートと同じように下に向かって順番に名前(まとめA列の該当行)・金額・固有 IDを出力します。


【検索後の処理(ヒットしないとき)】
固有IDがヒットしない、 IDがヒットしても金額があわなかったときには結果シート2に同じように名前・金額(もともとの検索している方の金額)・固有 IDを出力します。



【 301行以降は】

1・まとめシートの B301以降の金額を原本シートの AI2から下に向かってセルが空白になるまで検索し、一致した場合、下記の「名前」を比べます。



<金額一致による名前のあいまい比較>(まとめシート301行~1500行目迄の処理)
例・
まとめシート B301の同じ行のF列、 G~L 列までの内容
↑比較↓
原本シートでヒットした行の F列、G 列





原本シートのほうが名前がフルネームとなっているため、「含まれるかどうか」で検索してください。

301行の例でいえば、

B301の4000が原本AI3と一致しますので、そのとき、同じ行のまとめシートの検索ワードF301の「サイトウ」と同じ行のG~Lの斉藤、斎藤、齊藤、西東、西藤と、
原本のヒットした3行目のF列「斎藤 三郎」とG3のサイトウ サブロウ」に含まれるかどうか検索してほしいのです。1つでも含まれれば結果シートに出力します。

上記ですでにでた【検索後の処理】と同じ処理をします。1つのまとめシートの金額の中で、名前が何度ヒットしても1つだけしか結果シートには出力させません。エラー時も同様です。


【これらを繰り返し1500行まで行ってほしいです】
※途中、まとめシートの金額の数字が0もしくは空白のときは比較せずに、次の行の金額にすぐに移ります。



※1~300までのくくり、301~1500まではかわることがありますので、かえられるようにわかりやすくしていただけると助かります。(なお前半、後半の検索の仕方は変わりませんのでご安心ください。変えるのは前半1~500、後半501~2000まで等の検索範囲のみです)
※G~Lまでのくくりを変える可能性(例L~AA迄等)がありますので、それもかえられるように分かりやすくしていただけると助かります。(ただし、変えても連続しているものとします)
※原本の固有ID・名前・カナ・金額の列もこれもかわる可能性がありますので、ご注意ください。
(縦に連続することはかわりません。)列指定だけできるようにわかりやすくお願いいたします。

※途中エラーが入っているセルがありますが、エラーは空白と考えて検索を続けます。


かなりわかりにくいかもしれませんので、ご質問は何なりとお願いたします。

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912012/12/08 01:08:00

ポイント800pt

仕様を理解しきれていない部分もありますし、説明と絵が矛盾しているように見える部分もありますが、できるだけ説明の意図に沿った処理にしたつもりです。

ご確認ください。

Option Explicit

Sub CheckWS()
'// 処理範囲の設定
    Const Method1Rows = 2
    Const DataEnd1Row = 300
    Const Method2Rows = 301
    Const DataEnd2Row = 1500
    
'// シートの設定
    Dim matomeWS As Worksheet
    Set matomeWS = Worksheets("まとめシート")
    
    Dim masterWS As Worksheet
    Set masterWS = Worksheets("原本")
    
    Dim result1WS As Worksheet
    Set result1WS = Worksheets("結果シート")
    
    Dim result2WS As Worksheet
    Set result2WS = Worksheets("結果シート2")
    
    Dim isFound As Boolean
    
'// 前半の処理
    Dim r As Long
    Dim idRng As Range
    For r = Method1Rows To DataEnd1Row
        isFound = False
        Set idRng = masterWS.Columns("D:D").Find(what:=matomeWS.Cells(r, "C").Value, lookat:=xlWhole)
        If Not idRng Is Nothing Then
            If masterWS.Cells(idRng.Row, "AI").Value = matomeWS.Cells(r, "B").Value Then
                isFound = True
            End If
        End If
        If isFound = True Then
            result1WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                = matomeWS.Cells(r, "A").Resize(1, 3).Value
            masterWS.Cells(idRng.Row, "AT").Value = "入金準備" '// 【2】対応
        Else
            result2WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                = matomeWS.Cells(r, "A").Resize(1, 3).Value
        End If
    Next
'// 後半の処理
    Dim c As Long
    Dim priceRng As Range
    Dim firstRng As Range
    For r = Method2Rows To DataEnd2Row
        If IsNumeric(matomeWS.Cells(r, "B").Value) = True Then
            If matomeWS.Cells(r, "B").Value > 0 Then
                isFound = False
                Set priceRng = masterWS.Columns("AI:AI").Find(what:=matomeWS.Cells(r, "B").Value, lookat:=xlWhole)
                If Not priceRng Is Nothing Then
                    Set firstRng = priceRng
                    Do
                        '// 名前のチェック
                        For c = 6 To 12   '// F~L 列との比較
                            If Len(matomeWS.Cells(r, c).Value) = 0 Then Exit For
                            If InStr(masterWS.Cells(priceRng.Row, "F"), matomeWS.Cells(r, c).Value) > 0 Then
                                isFound = True
                                Exit Do
                            End If
                            If InStr(masterWS.Cells(priceRng.Row, "G"), matomeWS.Cells(r, c).Value) > 0 Then
                                isFound = True
                                Exit Do
                            End If
                        Next
                        Set priceRng = masterWS.Columns("AI:AI").FindNext(priceRng)
                    Loop While firstRng.AddressLocal <> priceRng.AddressLocal
                End If
                If isFound = True Then
                    With result1WS.Cells(Rows.Count, "A").End(xlUp)
                        .Offset(1, 0).Resize(1, 2).Value = matomeWS.Cells(r, "A").Resize(1, 2).Value
                        .Offset(1, 2).Value = masterWS.Cells(priceRng.Row, "D").Value  '// 【1】対応
                        masterWS.Cells(priceRng.Row, "AT").Value = "入金準備" '// 【2】対応
                    End With
                Else
                    result2WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = matomeWS.Cells(r, "A").Resize(1, 3).Value
                End If
            End If
        End If
    Next
End Sub
他14件のコメントを見る
id:Mook

一応コメント頂いた内容に対応したつもりです。

マクロの修正に関して
ご指名のお話は光栄ですが、現在ポイント送信の機能は停止しているようです。
また、はてなを長期に見ないこともありますので、連絡いただいても気が付かない可能性もあります。

質問に、回答者のリクエストという機能もあるようですので、こちらを利用されてはどうでしょうか。

2012/12/10 23:19:04
id:naranara19

ありがとうございました!今後も宜しくお願いいたします。ポイント送信機能って、便利だったのですが・・・。ヤフー等がやりはじめたのに、逆にはてなさんのメリットを消している気がいたしますね。それでも増額いたします。このたびは本当にありがとうございました。今後もリクエストさせていただきます。よろしくお願いいたします。

2012/12/11 02:23:15

その他の回答(1件)

id:sinrabanshyo No.1

sinrabanshyo回答回数139ベストアンサー獲得回数172012/12/07 17:20:06

ポイント5pt

関数のVLOOKUPとASUMIF,SUM関数を駆使するとできそうですが、1500行ともなると
重たくなりそうですね。
僕なら、VBAで組みます。

VBAで良ければコーディングします。

@elephantbeetle

id:naranara19

ぜひVBAでお願い致します。回答ありがとうございました。

2012/12/07 17:37:23
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912012/12/08 01:08:00ここでベストアンサー

ポイント800pt

仕様を理解しきれていない部分もありますし、説明と絵が矛盾しているように見える部分もありますが、できるだけ説明の意図に沿った処理にしたつもりです。

ご確認ください。

Option Explicit

Sub CheckWS()
'// 処理範囲の設定
    Const Method1Rows = 2
    Const DataEnd1Row = 300
    Const Method2Rows = 301
    Const DataEnd2Row = 1500
    
'// シートの設定
    Dim matomeWS As Worksheet
    Set matomeWS = Worksheets("まとめシート")
    
    Dim masterWS As Worksheet
    Set masterWS = Worksheets("原本")
    
    Dim result1WS As Worksheet
    Set result1WS = Worksheets("結果シート")
    
    Dim result2WS As Worksheet
    Set result2WS = Worksheets("結果シート2")
    
    Dim isFound As Boolean
    
'// 前半の処理
    Dim r As Long
    Dim idRng As Range
    For r = Method1Rows To DataEnd1Row
        isFound = False
        Set idRng = masterWS.Columns("D:D").Find(what:=matomeWS.Cells(r, "C").Value, lookat:=xlWhole)
        If Not idRng Is Nothing Then
            If masterWS.Cells(idRng.Row, "AI").Value = matomeWS.Cells(r, "B").Value Then
                isFound = True
            End If
        End If
        If isFound = True Then
            result1WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                = matomeWS.Cells(r, "A").Resize(1, 3).Value
            masterWS.Cells(idRng.Row, "AT").Value = "入金準備" '// 【2】対応
        Else
            result2WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                = matomeWS.Cells(r, "A").Resize(1, 3).Value
        End If
    Next
'// 後半の処理
    Dim c As Long
    Dim priceRng As Range
    Dim firstRng As Range
    For r = Method2Rows To DataEnd2Row
        If IsNumeric(matomeWS.Cells(r, "B").Value) = True Then
            If matomeWS.Cells(r, "B").Value > 0 Then
                isFound = False
                Set priceRng = masterWS.Columns("AI:AI").Find(what:=matomeWS.Cells(r, "B").Value, lookat:=xlWhole)
                If Not priceRng Is Nothing Then
                    Set firstRng = priceRng
                    Do
                        '// 名前のチェック
                        For c = 6 To 12   '// F~L 列との比較
                            If Len(matomeWS.Cells(r, c).Value) = 0 Then Exit For
                            If InStr(masterWS.Cells(priceRng.Row, "F"), matomeWS.Cells(r, c).Value) > 0 Then
                                isFound = True
                                Exit Do
                            End If
                            If InStr(masterWS.Cells(priceRng.Row, "G"), matomeWS.Cells(r, c).Value) > 0 Then
                                isFound = True
                                Exit Do
                            End If
                        Next
                        Set priceRng = masterWS.Columns("AI:AI").FindNext(priceRng)
                    Loop While firstRng.AddressLocal <> priceRng.AddressLocal
                End If
                If isFound = True Then
                    With result1WS.Cells(Rows.Count, "A").End(xlUp)
                        .Offset(1, 0).Resize(1, 2).Value = matomeWS.Cells(r, "A").Resize(1, 2).Value
                        .Offset(1, 2).Value = masterWS.Cells(priceRng.Row, "D").Value  '// 【1】対応
                        masterWS.Cells(priceRng.Row, "AT").Value = "入金準備" '// 【2】対応
                    End With
                Else
                    result2WS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = matomeWS.Cells(r, "A").Resize(1, 3).Value
                End If
            End If
        End If
    Next
End Sub
他14件のコメントを見る
id:Mook

一応コメント頂いた内容に対応したつもりです。

マクロの修正に関して
ご指名のお話は光栄ですが、現在ポイント送信の機能は停止しているようです。
また、はてなを長期に見ないこともありますので、連絡いただいても気が付かない可能性もあります。

質問に、回答者のリクエストという機能もあるようですので、こちらを利用されてはどうでしょうか。

2012/12/10 23:19:04
id:naranara19

ありがとうございました!今後も宜しくお願いいたします。ポイント送信機能って、便利だったのですが・・・。ヤフー等がやりはじめたのに、逆にはてなさんのメリットを消している気がいたしますね。それでも増額いたします。このたびは本当にありがとうございました。今後もリクエストさせていただきます。よろしくお願いいたします。

2012/12/11 02:23:15

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません