1323165593 EXCEL VBAについて質問です。良い回答は300~500ptを差し上げます。

以下のソースでは[大]→[中]シート内D列をproductNameで検索し、
一致したら書き込む処理をおこなってます。
これに、[大][中]シートの他に[小]シートがありまして、B列でproductNameを検索したいと思っております。
また、検索順は[大]→[中]→[小]としたいです。

ソースは、添付資料を参照願います。
ソースでの回答をお願いします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2011/12/06 18:59:55
  • 終了:2011/12/08 11:38:05

ベストアンサー

id:taknt No.2

きゃづみぃ回答回数13538ベストアンサー獲得回数11982011/12/07 00:55:17

ポイント500pt

Sub mysearch(srcWB As Workbook, prefname)
Dim productName As String
Dim wsName
Dim dstWs As Worksheet
Dim dstRow As Long
Dim r As Long
Dim f As Boolean

f = False
For Each wsName In Array("大", "中", "小")
    
    With srcWB.Worksheets(wsName)
        For r = 4 To Rows.Count
            If wsName = "小" Then
                productName = .Cells(r, "B")
            Else
                productName = .Cells(r, "D")
            End If
            If productName = "" Then Exit For
            On Error Resume Next
            Set dstWs = ThisWorkbook.Worksheets(productName)
            On Error GoTo 0
            If Not dstWs Is Nothing Then
                If wsName = "大" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "H")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
                If wsName = "中" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "E")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
                If wsName = "小" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "E")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
            
            End If
        Next
        If f Then
            Exit For
        End If
    End With
Next
End Sub

id:japan-nan

回答いただきありがとうございました。

2011/12/08 11:33:20

その他の回答(1件)

id:windofjuly No.1

うぃんど回答回数2625ベストアンサー獲得回数11492011/12/06 19:46:33

ポイント300pt

コード中にコメントいれてあるとおり疑問点がありますので、確認してください

Sub mySearch(srcWB As Workbook, prefName)
    Dim productName As String
    Dim wsName
    Dim dstWS As Worksheet
    Dim dstRow As Range
    Dim r As Long
    
    For Each wsName In Array("大", "中", "小")
        With srcWB.Worksheets(wsName)
            
            For r = 4 To Rows.Count
                productName = .Cells(r, "D")
                
                If productName = "" Then Exit For
                On Error Resume Next
                Set dstWS = ThisWorkbook.Worksheets(productName)
                On Error GoTo 0
                
                If Not dstWS Is Nothing Then
                    If weName = "大" Then
                        dstRow = dstWS.Cells(Rows.Count, "B").End(xlUp).Row + 1
                        dstWS.Cells(dstRow, "B").Value = prefName
                        dstWS.Cells(dstRow, "C").Value = productName
                        dstWS.Cells(dstRow, "E").Value = .Range("J2")
                        dstWS.Cells(dstRow, "F").Value = .Cells(r, "H"): '←大シートならH
                        Set dstWS = Nothing
                    ElseIf weName = "中" Then
                        dstRow = dstWS.Cells(Rows.Count, "B").End(xlUp).Row + 1
                        dstWS.Cells(dstRow, "B").Value = prefName
                        dstWS.Cells(dstRow, "C").Value = productName
                        dstWS.Cells(dstRow, "E").Value = .Range("J2")
                        dstWS.Cells(dstRow, "F").Value = .Cells(r, "E"): '←中シートならE
                        Set dstWS = Nothing
                    ElseIf weName = "小" Then
                        dstRow = dstWS.Cells(Rows.Count, "B").End(xlUp).Row + 1
                        dstWS.Cells(dstRow, "B").Value = prefName
                        dstWS.Cells(dstRow, "C").Value = productName
                        dstWS.Cells(dstRow, "E").Value = .Range("J2")
                        dstWS.Cells(dstRow, "F").Value = .Cells(r, "E"): '←小シートは?
                        Set dstWS = Nothing
                    End If
                End If
            Next r
        End With
    Next wsName
End Sub

お願い
画像はにじんでいて見づらかったりしますので、
次回からはコメント欄にコードをコピペして投稿するように願いたいです
(インデントは消えますが、エディタなどで簡単に入れることが出来るので、
気にしなくても結構です。1文字でも読み間違いがあると、そのほうが双方手間が増えます)

他3件のコメントを見る
id:windofjuly

>正しくは「wsName」でしょうか?

確認ありがとうございます
おっしゃるとおり入力ミスです

2011/12/07 20:04:58
id:japan-nan

回答いただきありがとうございました。

2011/12/08 11:33:34
id:taknt No.2

きゃづみぃ回答回数13538ベストアンサー獲得回数11982011/12/07 00:55:17ここでベストアンサー

ポイント500pt

Sub mysearch(srcWB As Workbook, prefname)
Dim productName As String
Dim wsName
Dim dstWs As Worksheet
Dim dstRow As Long
Dim r As Long
Dim f As Boolean

f = False
For Each wsName In Array("大", "中", "小")
    
    With srcWB.Worksheets(wsName)
        For r = 4 To Rows.Count
            If wsName = "小" Then
                productName = .Cells(r, "B")
            Else
                productName = .Cells(r, "D")
            End If
            If productName = "" Then Exit For
            On Error Resume Next
            Set dstWs = ThisWorkbook.Worksheets(productName)
            On Error GoTo 0
            If Not dstWs Is Nothing Then
                If wsName = "大" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "H")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
                If wsName = "中" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "E")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
                If wsName = "小" Then
                    dstRow = dstWs.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    dstWs.Cells(dstRow, "B").Value = prefname
                    dstWs.Cells(dstRow, "C").Value = productName
                    dstWs.Cells(dstRow, "E").Value = .Range("J2")
                    dstWs.Cells(dstRow, "F").Value = .Cells(r, "E")
                    Set dstWs = Nothing
                    f = True
                    Exit For
                End If
            
            End If
        Next
        If f Then
            Exit For
        End If
    End With
Next
End Sub

id:japan-nan

回答いただきありがとうございました。

2011/12/08 11:33:20

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

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

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

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

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