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には名前が300行程並んでいます。
一列目
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つだけですか?それとも複数存在する場合もありますか?
ユニークな文字列となります。
>
>それぞれのファイルには、シートはいくつありますか?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