Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

71909 / 76732

←次へ　｜　前へ→


	【9314】Re:手に負えない

ブーちゃん - 03/11/28(金) 11:00 -


	引用なし

	パスワード

とりあえず、書いてみましたが、この後が続きません。1つ１つLNを定義して、且つCase
毎に処理内容を書こうと思っているのですが、どうすれば良いでしょうか？
Sub Command Button1(wb As Workbook)
　 Dim RR&, Rmax&, Rpos&, II%, Rec$
　 Dim ws(1 To 2) As Worksheet
　 Dim PS(RR&) As Variant
Dim objWSH As Object
　　 Dim strPS　 As String
　　 Dim Ans
　　
　　Set objWSH = CreateObject("WScript.Shell")
　　On Error GoTo err_line
　　strPS = objWSH.SpecialFolders("\C:") & "\Excelファイル全集\" & _
　　　　　　　　　　Me.ListBox1.Text
　　　　
　　Ans = MsgBox(Me.ListBox1.Text & "をチェックしますか？", vbYesNo)
　　If Ans = vbYes Then Workbooks.Open strPS

err_line:
　　Select Case Err.Number
　　　　Case 0
　　　　Case 1004
　　　　　　MsgBox "ファイルがフォルダ中に存在しません"
　　　　Case Else
　　　　　　MsgBox Err.Number
　　End Select
　　Err.Clear
　　Set objWSH = Nothing
End Sub
　
　 Private Sub()
　 Dim LN1　As Boolean
　 Dim LN2　As Boolean
　 Dim LN15 As Boolean
　 Dim LN16 As Boolean
　
　
　 Dim PS　　As Long

LN1　= (Cells(RR&, 11).Value = 1) And _ (Cells(RR&, 13).Value = "A") And _ (Cells(RR&, 14).Value = 1) And _ (Cells(RR&, 18).Value = 1)’・・・(何も表示しない)
LN2　= (Cells(RR&, 11).Value = 2) And _ (Cells(RR&, 13).Value = "A") And _ (Cells(RR&, 14).Value = 1) And _ (Cells(RR&, 18).Value = 1)’・・・(何も表示しない)
LN15　= (Cells(RR&, 11).Value = 1) And _ (Cells(RR&, 13).Value = "A") And _ (Cells(RR&, 14).Value = 1) And _ (Cells(RR&, 18).Value = 0)’・・・(不具合A)
LN16　= (Cells(RR&, 11).Value = 2) And _ (Cells(RR&, 13).Value = "A") And _ (Cells(RR&, 14).Value = 1) And _ (Cells(RR&, 18).Value = 0)’・・・(不具合B)

Set ws(1) = ThisWorkbook.Worksheets("Sheet4")
　 ws(1).Cells.Clear 'Sheet4を初期化
　 Rpos& = 0 '書き出すときは上詰めで
　 '開始
　 On Error Resume Next
　 '『Sheet8&9』を検索ということ？
　 Set ws(2) = wb.Worksheets("Sheet8&9")
　 On Error GoTo 0
　 '『Sheet8&9』というシートが無かったらその後の処理は無し
　 If Not ws(2) Is Nothing Then
　　　With ws(2).UsedRange
　　　　 Rmax& = .Cells(.Count).Row
　　　End With
　　　For RR& = 8 To Rmax&
　　　　 'AFが0以外の時
　　　　 If ws(2).Cells(RR&, 32).Value <> 0 Then
　　　　　　With ws(2)
　　　　　　　 Rec$ = .Cells(RR&, 11).Value & .Cells(RR&, 13).Value & _
　　　　　　　　　　　.Cells(RR&, 14).Value & .Cells(RR&, 18).Value
　　　　　　End With

For RR& = 8 To Rmax&　　　　
VntTmp(RR&) = Me("Cells.Count" & RR&+ 1).ListIndex + 1
　　Next RR&
　　Select Case Join(PS, "_")
　　Case Join(LN1, "_")
　　　　→何も表示しない
　　Case Join(LN2, "_")
　　→何も表示しない　
　　Case Join(LN16, "_")
　　　LN16 .Value = "不具合A"
EntireRow.Font.ColorIndex = 3
　　Case Join(LN17, "_")
　　LN17.Value = "不具合B"
EntireRow.Font.ColorIndex = 3
Case Else
'定義漏れ
If ws(2).Cells(RR&, 15).Value = "×"
Then.Value = "定義漏れ"
.EntireRow.Font.ColorIndex = 44
End If
　　End Select
End Sub

1 hits

▼

【9213】手に負えない ブーちゃん 03/11/24(月) 2:48