| |
はじまして、imoriと申します。
現在以下のようなマクロを組んでいるのですが、
無限ループになってしまったり、分岐が上手くいかなかったりとで試行錯誤しており苦しんでおります。
どうかご教授ねがえませんでしょうか。
階層構造の末端部分のステータスによって、
一段階上のステータスが決まるマクロを書きたいです。
ステータスはOK、NG、保留があり、ステータス決定のルールは以下の通りです。
１．番号の下に階層が存在しない場合でステータスがブランクの場合は[保留]
２．番号の下に階層が存在しており、一つでもNGがあれば、上のステータスは[NG]
３．番号の下に階層が存在しており、NGがなく、一つでも保留があれば上のステータスは[保留]
４．番号の下に階層が存在しており、NG、保留がない場合は[OK]
以下のように並んでいる場合□の箇所のステータスを設定するマクロを作成したいです。
階層 番号 ステータス
1 000001 □(1)・・・2のステータスがNGのためNG
2 000002 □(2)・・・3のステータスにNGが存在するためNG
3 000003 OK
4 000004 OK
4 000005 OK
3 000006 □(3)・・・下の階層(4)にNGが存在するためNG
4 000007 NG
4 000008 □(4)・・・下に階層が続かないためステータスは[保留]
4 000009 OK
4 000010 NG
3 000011 □(5)・・・下の階層がOKのため[OK]
4 000012 OK
4 000013 OK
3 000014 OK
現在組んでいるマクロは以下の通りです。
以下の番号のステータスが一致しません。
000001
000002
他のやりかたを考えるべきと思い始めています。
ご教授願えますでしょうか。
Option Explicit
Sub Main()
Dim i, MaxRow As Long
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To MaxRow
階層設定 (i)
Next i
MsgBox "完了しました"
End Sub
Sub 階層設定(i)
Dim r, m, l As Long
Dim sArray() As String
m = 0
r = 0
Do While Range("C" & i).Value = ""
'行の次の行の階層レベルが同じもしくは次の行が小さい場合、その行は末端のためステータス「保留」
If Range("A" & i).Value >= Range("A" & i + 1) Then
Range("C" & i) = "保留"
'行の次の行の階層が+１の場合は下に階層がある
Else
r = i + 1
'次の行のステータスがブランクではない場合
If Range("C" & r).Value <> "" Then
'次の行のレベルと次の次の行のレベルが同一である限り配列に値格納
Do
ReDim Preserve sArray(m)
sArray(m) = Range("C" & r).Value
r = r + 1
m = m + 1
Loop While Range("A" & r) = Range("A" & r + 1)
Range("C" & i) = ステータス設定(sArray())
'配列の解放
m = 0
Erase sArray
Else
'****上と同じ処理が続いてしまう。
If Range("A" & r).Value >= Range("A" & r + 1) Then
'行の次の行の階層レベルが同じもしくは次の行が小さい場合、その行は末端のためステータス「保留」
Range("C" & r) = "保留"
Else
階層設定 (i + 1)
End If
End If
End If
Loop
End Sub
Function ステータス設定(sArray() As String) As String
Dim strResult, strTarget As String
strResult = Filter(sArray, "NG")
'NGが含まれている場合
If UBound(strResult) <> -1 Then
strTarget = "NG"
Else
'NGは含まれていないが、保留が含まれている場合
strResult = Filter(sArray, "保留")
If UBound(strResult) <> -1 Then
strTarget = "保留"
Else
strTarget = "OK"
End If
End If
ステータス設定 = strTarget
End Function
よろしくお願いします。
|
|
imori
- 15/5/21(木) 15:50 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
