| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 454 人关注过本帖
标题:[求助]vb出错
只看楼主 加入收藏
funnyray
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-12-1
收藏
 问题点数:0 回复次数:3 
[求助]vb出错

麻烦哪位哥哥能帮我看看我那里写错了,因为每当我测试的时候Validate的部分都说我出错,谢谢大家!

----------------------------------------------------
Private Sub cmdRun_Click()
Dim StrDir As String
Dim mintRow As Integer
Dim mintCol As Integer
Dim strColor As String
Dim intCurLine As Integer

    Initialize
    
    intRow = 4
    
    Do
        intRow = intRow + 1
        
        Validate
        
    Loop While Cells(intRow, 1).Value <> "" Or Cells(intRow, 2).Value <> ""
    
        
    
    For intRow = 1 To Cells(intRow, 1).Value <> ""
    
        ColorCell
    
    Next intRow
    

End Sub

----------------------------------------------------
Public Function MoveOneCell(StrDir As String) As Boolean
Dim mintRow As Integer
Dim mintCol As Integer
Dim blnSomeVar As Boolean


    Select Case StrDir
        Case "U"
            Cells(intRow + mintRow, intCol).Select
            
            
        Case "D"
            Cells(intRow - mintRow, intCol).Select
            
            
        Case "L"
            Cells(intRow, intCol + mintCol).Select
            
            
        Case "R"
            Cells(intRow, intCol + mintCol).Select
            
            
    End Select
            
            
End Function

----------------------------------------------------
Public Sub ColorCell(strColor As String, intRow As Integer, intCol As Integer)

    Select Case strColor
        Case "BLACK"
            Cells(intRow, intCol).Interior.Color = vbBlack
        Case "RED"
            Cells(intRow, intCol).Interior.Color = vbRed
        Case "GREEN"
            Cells(intRow, intCol).Interior.Color = vbGreen
        Case "YELLOW"
            Cells(intRow, intCol).Interior.Color = vbYellow
        Case "BLUE"
            Cells(intRow, intCol).Interior.Color = vbBlue
        Case "MAGENTA"
            Cells(intRow, intCol).Interior.Color = vbMagenta
        Case "CYAN"
            Cells(intRow, intCol).Interior.Color = vbCyan
        Case "WHITE"
            Cells(intRow, intCol).Interior.Color = vbWhite
     End Select

End Sub

----------------------------------------------------
Public Function Validate(intCurRow As Integer) As Boolean

Dim intMyRow As Integer
Dim intMyCol As Integer

    intCurRow = 4

    Select Case intCurRow

        Case Cells(intCurRow, 1).Value = "U"
            Validate True
        Case Cells(intCurRow, 1).Value = "D"
            Validate True
        Case Cells(intCurRow, 1).Value = "L"
            Validate True
        Case Cells(intCurRow, 1).Value = "R"
            Validate True
        Case Else
            Cells(intMyRow, intMyCol).Interior.Color = vbRed
            Validate False
            
    End Select
    
    Select Case intCurRow

        Case Cells(intCurRow, 2).Value >= 1
            Validate True
        Case Cells(intCurRow, 2).Value < 21
            Validate True
        Case Else
            Cells(intMyRow, intMyCol).Interior.Color = vbRed
            Validate False
            
    End Select
    
    Select Case intCurRow

        Case Cells(intCurRow, 1).Value = "BLACK"
            Validate True
        Case Cells(intCurRow, 1).Value = "RED"
            Validate True
        Case Cells(intCurRow, 1).Value = "GREEN"
            Validate True
        Case Cells(intCurRow, 1).Value = "YELLOW"
            Validate True
        Case Cells(intCurRow, 1).Value = "BLUE"
            Validate True
        Case Cells(intCurRow, 1).Value = "MAGENTA"
            Validate True
        Case Cells(intCurRow, 1).Value = "CYAN"
            Validate True
        Case Cells(intCurRow, 1).Value = ""
            Validate True
        Case Else
            Cells(intMyRow, intMyCol).Interior.Color = vbRed
            Validate False
            
    End Select
    
    
    Do While Cells(intCurRow, 1).Value <> "" And Cells(intCurRow, 2).Value <> ""
        intCurRow = intCurRow + 1
    Loop
    
    
    
End Function

----------------------------------------------------
内容在这里:
http://www.cs.uiuc.edu/class/fa06/cs105/mps/fall06/mp6/mp6.htm

[此贴子已经被作者于2006-12-1 13:22:14编辑过]

搜索更多相关主题的帖子: 哥哥 
2006-12-01 11:30
noctune
Rank: 1
等 级:新手上路
帖 子:47
专家分:0
注 册:2006-6-8
收藏
得分:0 

还要看那个链接上的东西。。,
建议你整理整理,再问问题。。。


世界上有两种人:懂二进制的和不懂二进制的。
2006-12-01 12:39
funnyray
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-12-1
收藏
得分:0 

这样设定可以吗?

intCurRow = 4

Select Case Cells(intCurRow, 1).Value

Case "U"
Validate = True
Case "D"
Validate = True
Case "L"
Validate = True
Case "R"
Validate = True
Case Else
Cells(intMyRow, intMyCol).Interior.Color = vbRed
Validate = False

End Select

2006-12-01 13:21
funnyray
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-12-1
收藏
得分:0 

这是连接部分,麻烦各位帮我看看,谢谢!

Sub Initialize()

' Those three variables are used to convert the BOGO instructions to upper case
Dim intRow As Integer
Dim intCol As Integer
Dim intMaxRow As Integer

' Reset the position on the board to top left corner
mintRow = 3
mintCol = 6

' Clear the board
Range("F3:Y22").Clear

' Convert the BOGO instructions to upper case and clear the color of the buggy line from previous run (if any)
intMaxRow = Application.CountA(Range("A:A")) + 1
For intRow = 4 To intMaxRow
For intCol = 1 To 3
Cells(intRow, intCol).Value = UCase(Cells(intRow, intCol).Value)
Cells(intRow, intCol).Interior.ColorIndex = xlColorIndexNone
Next intCol
Next intRow

End Sub

--------------------------------------------

Sub ValTest()
Range("AB24:AB100").Clear

Dim intCommentLine As Integer
Dim intCurLine As Integer

intCommentLine = 24
intCurLine = 10000
Dim blnTest As Boolean

'***Test Valid Inputs***

'Test Left
Cells(intCurLine, 1).Value = "L"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)

'Test Right
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Up
Cells(intCurLine, 1).Value = "U"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Down
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Blue
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "BLUE"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Green
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "GREEN"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Yellow
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "YELLOW"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Cyan
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "CYAN"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Magenta
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "MAGENTA"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Black
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "BLACK"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test White
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "WHITE"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

'Test Blank
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = ""
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)

If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Works Correctly for Valid Input"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Work Correctly for Valid Input"
End If
'***Done Testing Valid Inputs***


intCommentLine = intCommentLine + 1
blnTest = True

'Test Invalid Direction
Cells(intCurLine, 1).Value = "B"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Direction Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Direction Appropriately"
End If

intCommentLine = intCommentLine + 1
blnTest = True
'Test Invalid Num Cells
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "0"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)

Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "21"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest Or Sheets("Draw").Validate(intCurLine)

Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "-5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest Or Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Num Cells Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Num Cells Appropriately"
End If

intCommentLine = intCommentLine + 1
blnTest = True
'Test Invalid Colors
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "1"
Cells(intCurLine, 3).Value = "RD"
blnTest = Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Colors Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Colors Appropriately"
End If

Range("A10000:C10000").Clear


End Sub


--------------------------------------------

Sub ColorTest()

Dim intRow As Integer
Dim intCol As Integer
Dim intCommentLine As Integer
Dim blnTest As Boolean

intRow = 10000
intCol = 1
intCommentLine = 24


Range("A10000:C10000").Clear
Range("AB24:AB100").Clear
Sheets("Draw").ColorCell "RED", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbRed
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring red works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring red does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "GREEN", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbGreen
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring green works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring green does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "BLUE", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbBlue
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring blue works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring blue does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "CYAN", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbCyan
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring cyan works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring cyan does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "MAGENTA", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbMagenta
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring magenta works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring magenta does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "YELLOW", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbYellow
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring yellow works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring yellow does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "BLACK", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbBlack
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring black works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring black does NOT work"
End If

intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "WHITE", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbWhite
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring white works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring white does NOT work"
End If

Range("A10000:C10000").Clear

End Sub


--------------------------------------------

Sub MoveTest()

Dim intCommentLine As Integer
intCommentLine = 24
Dim blnTest As Boolean

Range("A10000:C10000").Clear
Range("AB24:AB100").Clear

'Test move left
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("L")
If (blnTest And (mintCol = 9) And (mintRow = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move left works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move left does NOT work"
End If

'Test move right
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("R")
If (blnTest And (mintCol = 11) And (mintRow = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move right works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move right does NOT work"
End If

'Test move up
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("U")
If (blnTest And (mintRow = 9) And (mintCol = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move up works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move up does NOT work"
End If

'Test move down
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("D")
If (blnTest And (mintRow = 11) And (mintCol = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move down works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move down does NOT work"
End If

'Test Left Boundary
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 6
blnTest = Sheets("Draw").MoveOneCell("L")
If (Not blnTest And (mintCol = 6)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at left boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at left boundary"
End If

'Test Right Boundary
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 25
blnTest = Sheets("Draw").MoveOneCell("R")
If (Not blnTest And (mintCol = 25)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at right boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at right boundary"
End If

'Test Upper Boundary
intCommentLine = intCommentLine + 1
mintRow = 3
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("U")
If (Not blnTest And (mintRow = 3)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at top boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at top boundary"
End If

'Test Bottom Boundary
intCommentLine = intCommentLine + 1
mintRow = 22
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("D")
If (Not blnTest And (mintRow = 22)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at bottom boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at bottom boundary"
End If

End Sub

2006-12-01 13:26
快速回复:[求助]vb出错
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.022791 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved