人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

EXCEL VBAについて質問です。良い回答は300?500ptを差し上げます。
以下のソースでは[大]→[中]シート内D列をproductNameで検索し、
一致したら書き込む処理をおこなってます。
これに、[大][中]シートの他に[小]シートがありまして、B列でproductNameを検索したいと思っております。
また、検索順は[大]→[中]→[小]としたいです。

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

1323165593
●拡大する

●質問者: japan-nan
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● うぃんど
●300ポイント

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

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文字でも読み間違いがあると、そのほうが双方手間が増えます)


japan-nanさんのコメント
回答いただきありがとうございます。 大、中シートの場合 productName = .Cells(r, "D") 小シートの場合 B列を検索したいと思っております。 productName = .Cells(r, "B")

うぃんどさんのコメント
文字化けしたので再投稿してます >B列を検索したい 下記のように訂正してください >|vb| productName = .Cells(r, "D") ↓ productName = IIf(wsName = "小", .Cells(r, "B"), .Cells(r, "D")) ||< ところで、 私のしめした疑問点は? 小シートも.Cells(r,E")で良いのですか? >|vb| dstWS.Cells(dstRow, "F").Value = .Cells(r, "H"): '←大シートならH dstWS.Cells(dstRow, "F").Value = .Cells(r, "E"): '←中シートならE dstWS.Cells(dstRow, "F").Value = .Cells(r, "E"): '←小シートは? ||<

rouge_2008さんのコメント
横からすみません。 VBAは分からないのですが、8行目で「For Each wsName In Array("大", "中", "小")」としていますが、条件分岐の3箇所すべてが「weName」となっています。 正しくは「wsName」でしょうか?

うぃんどさんのコメント
>正しくは「wsName」でしょうか? 確認ありがとうございます おっしゃるとおり入力ミスです

japan-nanさんのコメント
回答いただきありがとうございました。

2 ● きゃづみぃ
●500ポイント ベストアンサー

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


japan-nanさんのコメント
回答いただきありがとうございました。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ