[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別シートの表を参照するマクロについて教えて下さい。』（takuya）
マクロ初心者です。
過去の質問履歴を調べましたが、見つける事が出来ない為、宜しくお願い致します。
Ａ Ｂ Ｃ 種 類
1 サイズ 種類 コード サイズ Ａ Ｂ Ｃ Ｄ
2 Ｍ Ａ 0.6 Ｓ 0.5 0.7 0.8 0.9
3 Ｍ 0.6 0.8 0.9 1.0
4 Ｌ Ｂ 0.9 Ｌ 0.7 0.9 1.0 1.1
5 ＬＬ 1.2 1.3 1.5 1.8
Sheet1 "一覧表" Sheet2 "コード表"
上記の２つの表に於いて、『一覧表』でその行のサイズと種類に入力すると 『コード表』からサイズと種類が合致するコードを読み取り、『一覧表』の コードに自動入力したいと思います。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
値を入力したときに、参照するだけだったら 今回は数式の方が適したケースではないでしょうか？
VLOOKUP、MATCH、INDEX あたりの組合せでできるかと思います。 マクロでやるにしても、「列、行、を検索して表から引くという」ロジックは一緒では ないでしょうか。
（Mook） 2015/03/21(土) 11:53
Mookさんもおっしゃっていますが、関数でもよさそうな気がします。 =IF(OR(A2="",B2=""),"",IFERROR(INDEX(コード表!$B$2:$E$5,MATCH(A2,コード表!$A$2:$A$5,0),MATCH(B2,コード表!$B$1:$E$1,0)),"該当なし")) （se_9） 2015/03/21(土) 12:12
Mookさん、se_9さん、ご回答有難うございました。
関数で出来ました。
出来れば、勉強したいので、マクロで行った場合のコードを教えて頂けないで しょうか。
宜しくお願い致します。 （takuya） 2015/03/23(月) 08:21
あまり参考にならないと思いますけれど、一例ということで。 コードの書き方は人によってまちまちなので、他のやり方も試してみてはと思います。
値の検索は Find を使ったり、WorksheetFunction.Match のように EXCEL 関数を使う ことも出来ます。
Sub Sample()
With Worksheets("一覧表")
Dim r As Long
For r = 2 To 4 Step 2
.Cells(r, "C").Value = getCode(.Cells(r, "A").Value, .Cells(r, "B").Value)
Next
End With
End Sub
Function getCode(pSize, pType)
getCode = ""
If pSize = "" Or pType = "" Then Exit Function
With Worksheets("コード表")
Dim c As Long
For c = 2 To 5
If .Cells(1, c).Value = pType Then Exit For
Next
Dim r As Long
For r = 2 To 5
If .Cells(r, 1).Value = pSize Then Exit For
Next
If c <= 5 And r <= 5 Then getCode = .Cells(r, c).Value
End With
End Function
（Mook） 2015/03/23(月) 11:51
10:35 コードの構成を一部訂正。
関数のほうがいいような気もしますが勉強ということで。
>サイズと種類に入力すると・・・・・『一覧表』のコードに自動入力したいと思います。
ということなので、ThisWorkbookモジュールに。
Option Explicit
Dim dic As Object
Private Sub Workbook_Open()
MakeTable
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "一覧表" Then MakeTable
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
Dim r As Range
Dim k As String
Select Case Sh.Name
Case "一覧表"
Set r = Intersect(Target, Sh.Range("A1").CurrentRegion.Columns("A:B"))
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In r
k = c.EntireRow.Range("A1") & vbTab & c.EntireRow.Range("B1")
c.EntireRow.Range("C1").Value = dic(k)
Next
Application.EnableEvents = True
End Select
End Sub
Private Sub MakeTable()
Dim c As Range
Dim k As String
If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
dic.RemoveAll
With Sheets("コード表").Range("A1").CurrentRegion
For Each c In .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
k = c.EntireRow.Range("A1").Value & vbTab & c.EntireColumn.Cells(1).Value
dic(k) = c.Value
Next
End With
End Sub
（β） 2015/03/26(木) 10:25
いろんな書き方あるねぇ。 βさんと似てるけど、二段階Dictionaryで！！ 参考出品
Option Explicit
'==================================================
'ThisWorkBookモジュールに記載
Dim dic As Object 'コード表を入れる入れ物 C列 = dic(サイズ)(種類) のように使う
Dim CngFlg As Boolean 'コード表が変更されたことを示すフラグ
'==================================================
'メインのチェンジイベント
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "一覧表"
If Target.Address Like "$[A,B]$*" Then ListSheet Sh, Target
Case "コード表"
CngFlg = True
End Select
End Sub
'==================================================
'一覧表にコード表からデータを取り出して代入する処理
Private Sub ListSheet(Sh As Worksheet, Target As Range)
Dim i As Long
If CngFlg Or dic Is Nothing Then SetDic
Application.EnableEvents = False
On Error Resume Next
For i = Application.Min(Sh.Cells(Rows.Count, "A").End(xlUp).Row, Sh.Cells(Rows.Count, "B").End(xlUp).Row) To 2 Step -1
Sh.Cells(i, "C").Value = dic(Sh.Cells(i, "A").Value)(Sh.Cells(i, "B").Value)
Next i
On Error GoTo 0
Application.EnableEvents = True
End Sub
'==================================================
'コード表をDictionaryに取り込む
Private Sub SetDic()
Dim a
Dim r As Long
Dim c As Long
Set dic = CreateObject("Scripting.Dictionary")
a = Sheets("コード表").Range("A1").CurrentRegion.Value
With dic
For r = 2 To UBound(a, 1)
.Add a(r, 1), CreateObject("Scripting.Dictionary")
For c = 2 To UBound(a, 2)
.Item(a(r, 1)).Add a(1, c), CreateObject("Scripting.Dictionary")
.Item(a(r, 1)).Item(a(1, c)) = a(r, c)
Next c
Next r
End With
CngFlg = False
End Sub
Like演算子のところ、書き換え 12:27
（稲葉） 2015/03/26(木) 11:59
すみません、ちょっとスレ貸してください。 先ほどLike演算子で書き換えたときに、あれっと思ったのですが http://officetanaka.net/excel/vba/tips/tips35.htm
田中さんのSample1 で ＞「東京、横浜、千葉ではない住所を赤字」 →Like "[!東京,横浜,千葉]*" ってあるんですが Andに置きかえると Like "東*" And _ Like "京*" And _ Like "横*" And _ Like "浜*" And _ Like "千*" And _ Like "葉*" And _ Like ",* " こうなるんじゃないですかね？ （稲葉） 2015/03/26(木) 13:16
大変勉強になりました。
また、ご教示をお願い致します。
（takuya） 2015/03/30(月) 14:30
> If Cells(i, 1).Value Like "[!東京,横浜,千葉]*" Then _
これは、先頭1文字が
^^^^^^^^^
「東」
または「京」
または「,」
または「横」
または「浜」
または「,」
または「千」
または「葉」
のいずれかでなかったら、
という構文になっていると思います。
したがって、セルの値が
「京都府西上条」
「葉山市...」
「東海道」
「,,,,,」
などでも、色塗りされない結果になると思います。
[ ] の中は 1文字なので 、サンプルで2文字づつグループ化するために 使用されてるカンマ(,) はここでは不要でしょう。
> 住所録で「東京、横浜、千葉ではない住所を赤字」にするには
これを Like演算子で表現するのは不可能かと思います。 あえてLike演算子を使って書くなら
Not 文字列 Like "東京*" _ And Not 文字列 Like "横浜*" _ And Not 文字列 Like "千葉*"
くらいでしょうか？ . （kanabun） 2015/03/30(月) 16:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.