|
こんなかな?
ただ、"×"の数が多いとMsgBoxで表示しきれるか疑問ですが?
Option Explicit
Public Sub Sample()
'データ列数(A列〜E列の5列)
Const clngColumns As Long = 5
'除数の有る列位置(基準セルからの列Offsetで指定)
Const clngDivisor = 1
Dim i As Long
Dim j As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntDivisor As Variant
Dim vntDividend As Variant
Dim strResult As String
Dim strProm As String
'Listの左上隅セル位置を基準として設定(列見出しの最左セル位置)
Set rngList = ActiveSheet.Cells(1, "A")
With rngList
'データ行数を取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'データが無い場合
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'除数データを配列に取得
vntDivisor = .Offset(1, clngDivisor).Resize(lngRows + 1).Value
'被除数データを配列に取得
vntDividend = .Offset(1, clngDivisor + 1) _
.Resize(lngRows + 1, _
clngColumns - clngDivisor - 1).Value
End With
'データ行全てに就いて繰り返し
For i = 1 To lngRows
'除数が0じゃ無い場合
If vntDivisor(i, 1) <> 0 Then
'被除数に就いて繰り返し
For j = 1 To clngColumns - clngDivisor - 1
'もし、剰余が有るなら
If vntDividend(i, j) Mod vntDivisor(i, 1) > 0 Then
'変数にセル位置を追加
If strResult <> "" Then
strResult = strResult & " "
End If
strResult = strResult & rngList.Offset(i, _
clngDivisor + j).Address(False, False)
End If
Next j
End If
Next i
If strResult = "" Then
strProm = "×の該当無し"
Else
strProm = "×の該当 " & strResult
End If
Wayout:
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|