| |
こんなので出来そうですが
マスタ表がSheet1に有り
結果がSheet2に有る物とします
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim lngRow As Long
Dim lngColumn As Long
Dim rngTable As Range
Dim rngResult As Range
Dim vntData As Variant
Dim rngDiameter As Range
Dim rngWeight As Range
Dim strProm As String
'◆マスタ表の先頭セル位置を基準とする(表の左上隅のセル位置)
Set rngTable = Worksheets("Sheet1").Cells(1, "A")
'◆定数を出力する位置(「重量」の列見出しのセル位置)
Set rngResult = Worksheets("Sheet2").Cells(1, "A")
With rngTable
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'列数の取得
lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column
If lngColumns <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'径の値の範囲を取得
Set rngDiameter = .Offset(1).Resize(lngRows)
'重量の値の範囲を取得
Set rngWeight = .Offset(, 1).Resize(, lngColumns)
End With
With rngResult
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'重量、径の値を配列に取得
vntData = .Offset(1).Resize(lngRows, 2).Value
End With
'結果の表のデータ先頭から最終行まで繰り返し
For i = 1 To lngRows
'重量を探索
lngColumn = ListSearch(vntData(i, 1), rngWeight)
'径を探索
lngRow = ListSearch(vntData(i, 2), rngDiameter)
'定数を配列に出力
vntData(i, 1) = rngTable.Offset(lngRow, lngColumn).Value
Next i
'画面更新を停止
Application.ScreenUpdating = False
'結果を出力
rngResult.Offset(1, 2).Resize(lngRows).Value = vntData
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngTable = Nothing
Set rngResult = Nothing
Set rngDiameter = Nothing
Set rngWeight = Nothing
MsgBox strProm, vbInformation
End Sub
Private Function ListSearch(vntKey As Variant, rngScope As Range) As Long
Dim vntFound As Variant
'Matchによる逐次探索
vntFound = Application.Match(vntKey, rngScope, 1)
'もし、エラーで無いなら
If Not IsError(vntFound) Then
'もし、Key値と探索位置の値が等しいなら
If vntKey = rngScope(vntFound).Value Then
ListSearch = vntFound
Else
'戻り値として、行位置を代入
ListSearch = vntFound + 1
End If
Else
ListSearch = 1
End If
End Function
PS:
関数でも出来そうですが、式が相当長く成りそうですね
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
