| |
VBEには怒られる（ポップアップで間違っていると教えてもらえる）つくりですが、
希望する形を作ってみました。
----------------------------
Const syori As String = "syori" 'syoriシートの定義づけ
Dim R1 As Integer, C1 As Integer, i As Integer 'R1,C1,iの定義づけ
Sub mime()
Sheets(syori).Select
Range("A2").Select
With Sheets(syori).Cells(1, 1).CurrentRegion
R1 = .Rows.Count 'X軸の最終地点を探してくれる（行）
C1 = .Columns.Count 'Y軸の最終地点を探してくれる（列）
End With
a = (*.pdf,application/pdf,PDF) '*.pdfをありますが、ファイル名は15文字でユニークネーム。
b = (*.exe,Application/octet-stream, exe)
c = (*.doc,Application/msword,Word)
d = (*.ppt,application/vnd.ms-powerpoint,PowerPoint)
e = (*.xls,application/vnd.ms-excel,Excel)
f = (*.htm,text/html,HTML)
g = (*.lzh,application/octet-stream,lzh)
h = (*.txt,text/plain,Text)
上 = 2 '基点セルの行番号
左 = 5 '基点セルの列番号
With Sheets("filechk").Cells(2, 5).CurrentRegion '（2,5）をカレントにする
右 = 3 '右端は５行目までしか使わないので固定。
下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row '下端検出
End With
i = 2
Do whilehile i = C1
If Cells(i, 5, i, 7) = a Then '（i,5）から(i,7)の値がaと同じ時 開始位置：（E2:G2）
If Cells(i, 5, i, 7) = b Then '（i,5）から(i,7)の値がbと同じ時
If Cells(i, 5, i, 7) = c Then '（i,5）から(i,7)の値がcと同じ時
'以下hまでを比較
'･
'･
'･
Else 'a〜hまでのすべての条件に一致しないものに対して
Cells(i, 5).Interior.ColorIndex = 6 '該当するセルに黄色で色を塗る
loop
MsgBox "一致していない型がありました。色付セルを見直しましょう"
End Sub
------------------------------------
このような形です。
今まで作った動くプログラムの昨日の一部切り張りと
自分の力である程度整形してみました。
aからhまでに定義した値がセルの(i,5）〜(i,7）に
入っていたらＯＫ、どこかのセルに一つでも違う値が入っていたら
色付け＆メッセージを出す…といった処理をしたいと思っています。
例えば(*.xls,Application/msword,Word)だったら
セル色付け＆メッセージ、といった感じです。
ヘルプがインストールされていない環境の為、関数の勉強が不足している点が
多々あるとは思いますが、ご指導・ご教授を宜しくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
