「A.xls」というファイルに、
A B C
1 「所属グループ」 「所属チーム」 「ID」
2 X 1 1・3・4・6
3 X 2 2・5・7・8・9・15
4 X 3 10・11・12・14
5 X 4 13・16
6 Y 1 1・2・3・9
7 Y 2 4・5・11
8 Y 3 6・10
9 Z 1 1・4・6
10 Z 2 2・8・
11 Z 3 3・5・7・9
のように管理しているものを、
A B C
1 「所属グループ」 「ID」 「所属チーム」
2 X 1 1
3 X 2 2
4 X 3 1
5 X 4 1
6 X 5 2
7 X 6 1
8 X 7 2
9 X 8 2
10 X 9 2
11 X 10 3
・ ・
・ ・
・ ・
上記のように「所属グループ」をA列に「ID」をB列に置いた
「B.xls」ファイルを作成したいのですが、
既存の関数でやろうとしても上手くできませんでした。
ですので、「A.xls」のC列をデータベースとした、
下記の3つを引数にとるユーザ定義関数を作りたいと
思っているのですが、
所属グループ名 → 検索値1
所属ID → 検索値2
A.xls C列2~ → データベース
マクロの知識があまりない私にはここから先どのようにすればよいか分かりません。
お手数ですがどなたか教えてくれないでしょうか?
No.2
- 回答日時:
Public Const strDelimiter As String = "・" 'IDの区切り文字
Public Const strOldBookName As String = "Book1"
Public Const strNewBookName As String = "Book3"
Public Const strOldSheetName As String = "Sheet1"
Public Const strNewSheetName As String = "Sheet1"
Function getTeam(ByVal strGroup As String, ByVal intID As Integer) As Integer
Dim intTeam As Integer '所属チーム
Dim i As Long
Dim j As Integer
Dim aryID As Variant
Dim endRow As Long '検索終了行
'検索結果初期化
getTeam = -1
'検索
With Application.Workbooks(strOldBookName).Sheets(strOldSheetName)
'検索終了行
endRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To endRow
'所属グループで絞込み
If .Cells(i, 1).Text = strGroup Then
'IDで絞込み
aryID = Split(.Cells(i, 3).Text, strDelimiter)
For j = 0 To UBound(aryID)
If aryID(j) = intID Then
'HITしたら所属チームを取得して関数終了
getTeam = .Cells(i, 2).Value
Exit Function
End If
Next
End If
Next
End With
End Function
Sub test()
Dim i As Long
Dim endRow As Long '検索終了行
Application.ScreenUpdating = False
With Application.Workbooks(strNewBookName).Sheets(strNewSheetName)
'検索終了行
endRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To endRow
'所属チーム取得
.Cells(i, 3).Value = getTeam(.Cells(i, 1).Text, .Cells(i, 2).Value)
Next
End With
Application.ScreenUpdating = True
End Sub
getTeamに所属グループとIDを渡してやると、所属チームを返します。
検索に失敗したら-1が返ります。
(例:所属グループがY、IDが8)
B.xlsに
A B C
1 「所属グループ」 「ID」 「所属チーム」
2 X 1
3 X 2
4 X 3
5 X 4
6 X 5
7 X 6
8 X 7
9 X 8
10 X 9
11 X 10
・ ・
・ ・
・ ・
のように値を設定しておいて、test関数を実行すると、
A B C
1 「所属グループ」 「ID」 「所属チーム」
2 X 1 1
3 X 2 2
4 X 3 1
5 X 4 1
6 X 5 2
7 X 6 1
8 X 7 2
9 X 8 2
10 X 9 2
11 X 10 3
・ ・
・ ・
・ ・
のように、所属チームを埋めてくれます。
strOldBookNameを「A」、strNewBookNameを「B」にして、それぞれのシート名を適当なものに設定すれば動くのではないかと。
※A.xlsとB.xlsを同じプロセスで開いていることが条件。
とりあえずA.xlsを開いて、更に「開く」でB.xlsを開けばOK。
ご回答ありがとうございました。
私のやり方がいけないのか、
testマクロを実行すると
「インデックスが有効範囲にない」という
エラーが起きてしまいました。
貴重なお時間を私のために割いて頂きありがとうございました。
何が悪かったのか私も勉強しながら、
ソースを追っていきたいと思います。
No.1ベストアンサー
- 回答日時:
こんばんは。
マクロならまだしも、ユーザー定義関数ですと、これは、3次元ですから、なかなかややこしいです。
本来、C列に、「1・3・4・6」のような書き方は、データとして不安定になりやすく、ワン・セルには、ワン・データというほうが扱いやすいです。
今回、あまり、難しくせずに作ってみました。
区切り文字は、「・」としていますが、混在は出来ませんが、違うものなら、「区切り文字」の部分に、任意で入れてください。見つからない場合は、「?」が出ます。
ユーザー定義関数は、シートに置いたままにすると、量が多くなると、配列数式と同じくシートが重くなります。その場合は、値貼り付けしてしまってください。
検索値の大文字・小文字/全角・半角のの区別はありません。
数式例:
=ThreeD(A2,B2,[A.xls]Sheet1!$A$2:$C$11)
コードの登録は、値を出す側のブックの標準モジュールです。間違えないようにしてください。
--------------------------------------------
Public Function ThreeD(ByVal Grp As String, ByVal ID As String, mData As Range, Optional Delim As String)
'引数:検索グループ名,検索ID, データ範囲(3列),[区切り文字]
Dim myDic As Object ' New Dictionary
Dim ky As Variant
Dim Ar As Variant
Dim c As Variant
Dim v As Variant
Dim x As Variant
Dim i As Long, j As Long
Dim a As Variant, b As Variant
Dim n As String
Dim flg As Boolean
flg = False
If Delim = "" Then Delim = "・"
Set myDic = CreateObject("Scripting.Dictionary")
myDic.CompareMode = 1 'TextCompare
For Each c In mData
ky = Trim(c.Value) & "-" & Trim(c.Offset(, 1).Value)
Ar = Split(c.Offset(, 2).Value, Delim)
For Each v In Ar
On Error Resume Next
myDic.Add ky, v
If Err.Number > 0 Then
myDic.Item(ky) = myDic.Item(ky) & "," & v
Err.Clear
End If
Next v
Next c
For Each x In myDic.Keys
n = InStr(1, x, Grp & "-", 1)
If n > 0 Then
a = Mid(x, n + 2)
b = myDic.Item(x) & ","
j = InStr(1, b, ID & ",", 1)
If j > 0 Then
flg = True
Exit For
End If
End If
Next x
If flg Then
ThreeD = a
Else
ThreeD = "?"
End If
End Function
ご回答頂きありがとうございました!
こちら試してみたところ、
私の思い描いていたイメージどおりの
動作をしてくれました!!
本当にありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- その他(Microsoft Office) Excelの表記ゆれについて <状況詳細> 7000人を対象とした一覧表があり、それぞれが各支社やチ 2 2023/06/02 15:08
- Access(アクセス) Access2016のExcelインポートの機能のことで教えてください 1 2022/09/11 14:58
- Visual Basic(VBA) エクセルVBA Workbook変数に変数を使ったファイル名を格納したい 5 2023/06/13 14:46
- Visual Basic(VBA) 動かなくなってしまった古いVBAを動くようにしたい 8 2022/09/20 13:57
- C言語・C++・C# c言語の問題です 2 2023/07/21 10:51
- Excel(エクセル) 【マクロ】マクロが保存されているエクセルとは、別のエクセルブックの全シートの非表示列を再表示したい 1 2022/12/24 20:48
- MySQL PHPとMySQLを使った掲示板の作り方 1 2022/06/02 13:00
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Access レポート印刷するときに...
-
アクセスクエリの計算
-
エクセルのデータをアクセスに...
-
【至急・画像あり】建物or住所...
-
Accessのリンクテーブルのパス...
-
Accessのクエリで、replace関数...
-
日付のテキストボックスに(例...
-
Accessのスプレッドシートエク...
-
Access VBA を利用して、フォル...
-
Microsoft Accessをクレジット...
-
Accessのデータ型の日付/時刻型...
-
accessの代わりになるもの
-
ms access 2013で、チェックボ...
-
マイクロソフト アクセス2021の...
-
エクセルのマクロについて教え...
-
AccessVBAで任意の複数リンクテ...
-
Access Error3061 パラメータが...
-
Access VBA [リモートサーバー...
-
Accessのフォーム上のテキスト...
-
accessでlaccdbファイルが削除...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Access レポート印刷するときに...
-
Access Error3061 パラメータが...
-
Microsoft365にAccessってあり...
-
Accessのクエリで、replace関数...
-
Accessのリンクテーブルのパス...
-
Access VBA [リモートサーバー...
-
ACCESS VBA でのエラー解決の根...
-
accessデータを指定したExcel、...
-
Accessのスプレッドシートエク...
-
CSVファイルの「0落ち」にVBA
-
【Access】Dcount関数の複数条...
-
Accessのフォーム上のテキスト...
-
Access VBA を利用して、フォル...
-
実行時エラー3131 FROM 句の構...
-
Vba Userformを前面に出すについて
-
Accessでフォームに自動入力し...
-
Accessレポートのチェックボッ...
-
Accessのテキストボックスの入...
-
Access 複数条件検索の設定が上...
-
accessのフォームに設置したボ...
おすすめ情報