Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2535 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【67419】検索にマッチする列の最後に値を追加したい。 momoiro 10/12/2(木) 15:09 質問[未読]
【67420】Re:検索にマッチする列の最後に値を追加し... UO3 10/12/2(木) 16:08 回答[未読]
【67423】Re:検索にマッチする列の最後に値を追加し... UO3 10/12/2(木) 16:20 発言[未読]
【67424】Re:検索にマッチする列の最後に値を追加し... momoiro 10/12/2(木) 16:22 回答[未読]
【67421】Re:検索にマッチする列の最後に値を追加し... metabeaux 10/12/2(木) 16:11 回答[未読]
【67422】Re:検索にマッチする列の最後に値を追加し... momoiro 10/12/2(木) 16:19 回答[未読]
【67425】Re:検索にマッチする列の最後に値を追加し... kanabun 10/12/2(木) 17:19 発言[未読]
【67426】Re:検索にマッチする列の最後に値を追加し... kanabun 10/12/2(木) 17:23 発言[未読]
【67419】検索にマッチする列の最後に値を追加した...
質問  momoiro  - 10/12/2(木) 15:09 -
引用なし
パスワード
   お世話になっております。
お暇な時にご回答頂けると幸いです。

対象一覧.xlsには名前が３００行程並んでいます。
一列目
kyototarou
kyotohanako
oosakatarou
oosakahanako
・
・
・

マスター.xlsには名前,数値,数値...と並んでいます。
列数は行によって、不定となります。

例
kyototarou,1,2
kyotohanako,1,2,3
oosakatarou,1
oosakahanako,1,2,3,4
・
・
・

質問内容は、対象一覧にある名前を検索値として、マスター.xlsを範囲とします。
マッチする行の列の最後に'9'を追加したいのです。

例
kyototarou,1,2,9
kyotohanako1,2,3,9
oosakatarou,1,9
ooskaahanako,1,2,3,4,9
.
.
.

以上の事をVBAで実現できないでしょうか。
よろしくお願いします。
【67420】Re:検索にマッチする列の最後に値を追加...
回答  UO3  - 10/12/2(木) 16:08 -
引用なし
パスワード
   ▼momoiro さん：

こんにちは
要件を取り間違えているかもしれませんが。

（Matchを 照合型0　という効率の悪い方法で使っていますがご容赦）

Sub Sample()
　Dim msWB As Workbook, dtWB As Workbook
　Dim msSH As Worksheet, dtSH As Worksheet
　Dim tblA As Range
　Dim i As Long
　Dim ck As Variant
　
　Application.ScreenUpdating = False
　
　Set msWB = Workbooks.Open(ThisWorkbook.Path & "\マスター.xls")
　'もし、既に開かれているなら　Set msDB = Workbooks("マスター.xls")
　Set dtWB = Workbooks.Open(ThisWorkbook.Path & "\対象一覧.xls")
　'もし、既に開かれているなら　Set dtDB = Workbooks("対象一覧.xls")
　Set msSH = msWB.Worksheets("Sheet1")
　Set dtSH = dtWB.Worksheets("Sheet1")
　
　With msSH
　　Set tblA = .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row)
　End With
　
　With dtSH
　　For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
　　　ck = Application.Match(.Cells(i, "A").Value, tblA, 0)
　　　If IsNumeric(ck) Then
　　　　msSH.Cells(ck, msSH.Columns.Count).End(xlToLeft).Offset(0, 1).Value = 9
　　　End If
　　Next
　End With
　
　Set msWB = Nothing
　Set dtWB = Nothing
　Set msSH = Nothing
　Set dtSH = Nothing
　Application.ScreenUpdating = True
　
End Sub
【67421】Re:検索にマッチする列の最後に値を追加...
回答  metabeaux  - 10/12/2(木) 16:11 -
引用なし
パスワード
   例では、対象一覧とマスターとで、名前の行位置が同じなのですが、そうとは限らないんですよね？

対象一覧にある名前は、マスターに必ずあるのでしょうか？

マスターに、同じ名前は1つだけですか？それとも複数存在する場合もありますか？

それぞれのファイルには、シートはいくつありますか？1枚だけ？服すうまいある場合、何枚目が処理対象シートですか？

とりあえず、「対象一覧にある名前がマスターに無い場合もある」「マスターには同じ名前は1つしかない」「どっちのファイルも1シート目が処理対象ファイル」という前提で作ってみました。

いくつかある方法のうちの一例です。

ファイルは両方開かれている状態で実行してください。

Sub test()
　　Dim ShRef As Worksheet, ShMas As Worksheet
　　Set ShRef = Workbooks("対象一覧.xls").Sheets(1)
　　Set ShMas = Workbooks("マスター.xls").Sheets(1)
　　Dim r As Long
　　For r = 1 To ShRef.Cells(ShRef.Rows.Count, 1).End(xlUp).Row
　　　　Dim Fnd As Range
　　　　Set Fnd = ShMas.Cells.Find(ShRef.Cells(r, 1).Value, , , xlWhole)
　　　　If Not Fnd Is Nothing Then
　　　　　　Fnd.EntireRow.Cells(Columns.Count).End(xlToLeft).Offset(, 1).Value = 9
　　　　End If
　　Next r
End Sub
【67422】Re:検索にマッチする列の最後に値を追加...
回答  momoiro  - 10/12/2(木) 16:19 -
引用なし
パスワード
   早速のご回答ありがとう御座います。
また、説明不足で申し訳ありません。
以下回答致します。

▼metabeaux さん：
>例では、対象一覧とマスターとで、名前の行位置が同じなのですが、そうとは限らないんですよね？
名前の列は両ﾌｧｲﾙ共に、必ず１列目となります。
>
>対象一覧にある名前は、マスターに必ずあるのでしょうか？
無い場合もあります。
>
>マスターに、同じ名前は1つだけですか？それとも複数存在する場合もありますか？
ユニークな文字列となります。
>
>それぞれのファイルには、シートはいくつありますか？1枚だけ？服すうまいある場合、何枚目が処理対象シートですか？
必ず一枚目のシートとなります。

再考の程よろしくお願いします。
提示して頂いているソースも確認させて頂きます。
※まだ確認していないので。
【67423】Re:検索にマッチする列の最後に値を追加...
発言  UO3  - 10/12/2(木) 16:20 -
引用なし
パスワード
   補足と訂正

Set msWB = Workbooks.Open(ThisWorkbook.Path & "\マスター.xls")
Set dtWB = Workbooks.Open(ThisWorkbook.Path & "\対象一覧.xls")

パスは仮です。正しいものにどうぞ。

'もし、既に開かれているなら　Set msDB = Workbooks("マスター.xls")
'もし、既に開かれているなら　Set dtDB = Workbooks("対象一覧.xls")

msDB、dtDB ではなく　msWB、dtWB です。
【67424】Re:検索にマッチする列の最後に値を追加...
回答  momoiro  - 10/12/2(木) 16:22 -
引用なし
パスワード
   ▼UO3 さん　
ご回答ありがとう御座います。
提示して頂いたソースで確認してみます。
また結果がわかり次第ご返事致します。

時間がかかるかもしれませんが。
【67425】Re:検索にマッチする列の最後に値を追加...
発言  kanabun  - 10/12/2(木) 17:19 -
引用なし
パスワード
   おじゃまします

metabeaux さんの

>いくつかある方法

のうちの（たぶん）ひとつです。
Dictionaryを使う方法です。

Sub Try1()　'両Book はともに開かれているものとします.
　　Dim WS1 As Worksheet
　　Dim WS2 As Worksheet
　　Dim dic As Object
　　Dim r As Range
　　Dim v, u, w
　　Dim i As Long, j As Long, jj As Long
　　
　　Set WS1 = Workbooks("対象一覧.xls").Worksheets(1)
　　Set WS2 = Workbooks("マスター.xls").Worksheets(1)
　　v = WS1.[A1].CurrentRegion.Resize(, 1).Value
　　With WS2.UsedRange
　　　　u = .Resize(, 1).Value
　　　　jj = .Columns.Count
　　　　Set r = .Offset(, 1).Resize(, jj)
　　　　w = r.Value
　　End With
　　　　
　　With CreateObject("Scripting.Dictionary")
　　　　'----------- 対象一覧 A列(名前) を辞書に登録する
　　　　For i = 1 To UBound(v)
　　　　　　.Item(v(i, 1)) = Empty
　　　　Next
　　　　'-------- マスター照合
　　　　For i = 1 To UBound(u)
　　　　　　If Not IsEmpty(u(i, 1)) Then
　　　　　　　　If .Exists(u(i, 1)) Then
　　　　　　　　　　For j = 2 To jj
　　　　　　　　　　　　If IsEmpty(w(i, j)) Then
　　　　　　　　　　　　　　w(i, j) = 9
　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　End If
　　　　　　　　　　Next
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
　　r.Value = w
End Sub
【67426】Re:検索にマッチする列の最後に値を追加...
発言  kanabun  - 10/12/2(木) 17:23 -
引用なし
パスワード
   ↑すみません、訂正です

>　　　　'-------- マスター照合
の内側のLoop
>　　　　For i = 1 To UBound(u)
>　　　　　　If Not IsEmpty(u(i, 1)) Then
>　　　　　　　　If .Exists(u(i, 1)) Then
>　　　　　　　　　　For j = 2 To jj
　　　　　　　　　　　　　　↓
　　　　　　　　　　For j = 1 To jj
でした m(_ _)m
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2535 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free