1 For Each row In region.Rows ' 行のループ
23 For Each cell In row.Columns
45 item = cell.Value
67 '空欄チェック、文字が無ければエラーメッセージを出して止める
8 If item = "" Then
9 MsgBox "空欄があります、確認してください。"
10 cell.Activate
11 End
12 Else '文字があれば、学部シートの学部名から一致する値を探す
1314 '一致する値がある場合、セルに学部ID値を入れて値を置換する
15 cell.Value = "学部ID値"
1617 '一致する値がない場合、エラーメッセージを出す
18 'MsgBox "紐付いている値がありません、確認してください。"
1920 End If
2122 Next
1Dim gakubu As Worksheet
2Dim gakka As Worksheet
3Dim result As Range
4Dim r As Long
56Set gakubu = Worksheets("学部")
7Set gakka = Worksheets("学科")
89r = 2
10Do While gakka.Cells(r, 2).Value <> ""
11 Set result = gakubu.Range("B:B").Find(gakka.Cells(r, 2).Value)
12 If Not result Is Nothing Then
13 gakka.Cells(r, 2).Value = gakubu.Cells(result.Row, 1).Value
14 End If
15 r = r + 1
16 DoEvents
17Loop
18
1'関数入力案
2Sub test1()
3 Dim rngTable As Range '更新対象の表
4 Dim rngKey As Range '検索の索引になるセル範囲
5 Dim rngTemp As Range '数式を一時的に入れるセル範囲
6 Dim rngList As Range '変更の元となる一覧表
7 Dim strFormula As String '数式とする文字列
89 'セル範囲特定
10 With Sheets("学科").Range("A1").CurrentRegion
11 Set rngTable = .Cells
12 Set rngKey = Intersect(.Offset(1), .Columns(2))
13 Set rngTemp = Intersect(.Offset(1).EntireRow, .Columns(.Columns.Count + 1))
14 End With
15 With Sheets("学部").Range("A1").CurrentRegion
16 Set rngList = Intersect(.Cells, .Offset(1))
17 End With
1819 '1行目の数式の作成(2行目以降はエクセル君に任せる)
20 strFormula = "=INDEX(" & rngList.Address(, , , True) & ",MATCH(" & _
21 rngKey(1).Address(False, False, , external:=True) & "," & _
22 rngList.Columns(2).Address(, , , True) _
23 & ",0),1)"
2425 '数式の入力
26 rngTemp.Formula = strFormula
27 '値のみ転記
28 rngTemp.Copy
29 rngKey.PasteSpecial xlPasteValues
30 '作業列のクリア
31 rngTemp.ClearContents
32End Sub
3334'繰返し置き換える案
35Sub test2()
36 Dim rngList As Range
37 Dim rngTable As Range
38 Dim r As Range
3940 With Sheets("学部").Range("A1").CurrentRegion
41 Set rngList = Intersect(.Cells, .Offset(1))
42 End With
43 Set rngTable = Sheets("学科").Range("A1").CurrentRegion
4445 For Each r In rngList.Rows
46 rngTable.Columns(2).Replace r.Cells(2).Value, r.Cells(1).Value
47 Next
48End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。