最近帮一个朋友求助，问能不能把excel里某一列的时间钟，把大于一个时间的单元格标记出来。有一个参考时间，从参考时间算起往后数3天，遇到节假日自动顺延。



代码如下






Private Sub Workbook_Open()
Dim rng1 As Range
Dim rng2 As Range

Dim i As Integer
Dim flag As Boolean
Dim j As Integer
Dim allrows As Integer

Dim tempDate As Date
Dim validateDates(1 To 3) As Date
Dim japanHolidays(1 To 17) As Date

Set rng1 = ThisWorkbook.Application.Range("A1")
allrows = ThisWorkbook.Application.Range("B65536").End(xlUp).Row
Set rng2 = ThisWorkbook.Application.Range("B1:B" & allrows)

i = 1
flag = True
j = 1

tempDate = DateSerial(Year(rng1.Value), Month(rng1.Value), Day(rng1.Value))


japanHolidays(1) = #1/1/2015#
japanHolidays(2) = #1/12/2015#
japanHolidays(3) = #2/11/2015#
japanHolidays(4) = #3/21/2015#
japanHolidays(5) = #4/29/2015#
japanHolidays(6) = #5/3/2015#
japanHolidays(7) = #5/4/2015#
japanHolidays(8) = #5/5/2015#
japanHolidays(9) = #5/6/2015#
japanHolidays(10) = #7/20/2015#
japanHolidays(11) = #9/21/2015#
japanHolidays(12) = #9/22/2015#
japanHolidays(13) = #9/23/2015#
japanHolidays(14) = #10/12/2015#
japanHolidays(15) = #11/3/2015#
japanHolidays(16) = #11/23/2015#
japanHolidays(17) = #12/23/2015#

While flag
    If Weekday(tempDate, vbMonday) > 5 Or isHoliday(tempDate, japanHolidays) Then
       tempDate = DateAdd("d", 1, tempDate)
    Else
        validateDates(i) = tempDate
        i = i + 1
        tempDate = DateAdd("d", 1, tempDate)
            If i = 4 Then
                flag = False
            End If
    End If
Wend

Debug.Print tempDate


For j = 1 To rng2.Rows.Count
    rng2.Cells(j, 1).Select

    If shouldMarked(DateSerial(Year(rng2.Cells(j, 1).Value), Month(rng2.Cells(j, 1).Value), Day(rng2.Cells(j, 1).Value)), validateDates) Then

        rng2.Cells(j, 1).Interior.ColorIndex = 3
        Else
            rng2.Cells(j, 1).Interior.ColorIndex = 0
    End If



Next
rng2.Cells(1, 1).Select
End Sub


Private Function isHoliday(tempDate1 As Date, japanHolidays1() As Date) As Boolean
Dim k As Integer
isHoliday = False
For k = 1 To UBound(japanHolidays1)
If (japanHolidays1(k) = tempDate1) Then
isHoliday = True
Exit For
End If
Next
End Function


Private Function shouldMarked(tempDate1 As Date, validateDates1() As Date) As Boolean
Dim q As Integer
shouldMarked = False
For q = 1 To UBound(validateDates1)
If (validateDates1(q) = tempDate1) Then
shouldMarked = True
Exit For
End If
Next
End Function

　　假如某For循环中，最终发现当i=31时出错，这时你需要在i=31时单步调试，有4个方法：

 
1.在n = fun1(i)行设置断点，然后按F5一步步到i=31时改按F8进入子函数单步调试

 
2.插入一小片代码设置断点，例如：

 
 
 
 
  
 
   Visual Basic code
    
   
 
   
 
   ?
  
 
  
 
      

        1
      
 
      

        2
      
 
      

        3
      
 
      

        4
      
 
      

        5
      
 
      

        6
      
 
      

        7
      
 
      

        8
      
 
      

        9
      
 
      

        10
      
 
 
      
 
       
 
        Dim 
        i%, n%
       
 
       
 
        For 
        i = 1 
        To 
        100
       
 
       
 
            
        '其他代码
       
 
       
 
            
        if i=31 then
       
 
       
 
                
        aa=1
        '在这行设置断点，这行本身没有意义就是为了可以设置断点的。
       
 
       
 
            
        end if
       
 
       
 
            
        n = fun1(i)
       
 
       
 
            
        debug.print i,n
       
 
       
 
            
        '其他代码
       
 
       
 
        Next
       
 
      
 
 
 
 
 

 
3.用debug.assert

 
 
 
 
  
 
   Visual Basic code
    
   
 
   
 
   ?
  
 
  
 
      

        1
      
 
      

        2
      
 
      

        3
      
 
      

        4
      
 
      

        5
      
 
      

        6
      
 
      

        7
      
 
      

        8
      
 
 
      
 
       
 
        Dim 
        i%, n%
       
 
       
 
        For 
        i = 1 
        To 
        100
       
 
       
 
            
        '其他代码
       
 
       
 
            
        debug.assert i<>31
       
 
       
 
            
        n = fun1(i)
       
 
       
 
            
        debug.print i,n
       
 
       
 
            
        '其他代码
       
 
       
 
        Next
       
 
       
 
        4.和debug.assert类似：
 右击代码区中的i，选择菜单“添加监视”，在表达式框里输入i=31，下面选择“当表达式值为真时中断”，
       
 
       
 
        这样就ok了，一句代码不要。
       
 
      
 
 
 
 

 
关于vb中删除数据库记录的语句
 
Sql = "select * from 班级信息where 姓名='" & Trim(Text1.Text) & "'"
 
rsd.Open Sql, conn, adOpenStatic, adLockOptimistic
 
YN = MsgBox("确定删除", vbYesNo)
 
If YN = 6 Then
 
rsd.Delete
 
End If
 
rsd.Close
 
conn.Close
 
如果有多条张三的记录，只能删除第一条记录。
 
如果想删除查询到的多条记录，请做一个循环。
 
vb中怎幺通过adodc删除数据库表中的所有数据
 
VB通过Sql结构化查询语句中Delete子句，赋值给Adodc数据控件的RecordSource 属性，来执行删除数据库一个表的所有记录。
 
RecordSource 属性，返回或设置Data控件的基本表、SQL语句。
 
SQL 语句：
 
SQL 中的以关键字打头、完整描述一个操作的完整的短语。例如：SELECT * FROM Orders。SQL 语句不应和语句混淆。
 
以下是删除wd.mdb数据库的jishijilu记录表的所有记录的代码：
 
Private?Sub?Command1_Click()
 
Dim?sql?As?String
 
On?Error?GoTo?error
 
sql?=?"delete?*?from?jishijilu"
 
Adodc1.ConnectionString?=?"Provider=Microsoft.Jet.OLEDB.4.0;Data?Source="?&?App.Path?&?"\data\wd.mdb;Persist?Security?Info=False"
 
Adodc1.RecordSource?=?sql
 
Adodc1.Refresh
 
Exit?Sub
 
error:
 
End?Sub
 
VB中使用SQL语句删除记录
 
Private Sub Form_Load()
 
Dim 空白 As New ADODB.Connection
 
Dim rs As New ADODB.Recordset
 
空白.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\TEST.mdb"
 
空白.Execute ("delete from TEST where NAME_CODE=0567") '此处的0567不是数字类型所以要改为
 
空白.Execute ("delete from TEST where NAME_CODE='0567'") '加上单引号
 
End Sub
 
VB中如何向SQL数据库中的表添加和删除数据
 
链接数据库的字符串
 
Public Const Conn As String = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
 
"User ID=sa;PWD=sa;Initial Catalog=hr;Data Source=127.0.0.1"
 
'hr是数据库名称 Catalong=数据库名称
 
Private IsConnect As Boolean 判读数据库是否链接
 
Private 空白n As ADODB.Connection 链接数据库的connection对象
 
Private rs As ADODB.Recordset 保存结果集的recordset对象
 
数据库链接程序
 
Public Sub Db_Connect()
 
如果链接标记为真 返回
 
If IsConnect = True Then
 
Exit Sub
 
End If
 
关键字New用来创建新对象空白n
 
Set 空白n = New ADODB.Connection
 
设置空白n的链接字符串的connectstring属性
 
空白n.ConnectionString = Conn
 
打开数据库
 
空白n.Open
 
判断链接状态
 
If 空白n.State <> adStateOpen Then
 
如果不成功 显示提示 退出程序
 
MsgBox "链接数据库失败"
 
End
 
End If
 
设置链接标记 表示已经链接到数据库
 
IsConnect = True
 
End Sub
 
断开数据库的链接程序
 
Public Sub Db_Disconnect()
 
如果链接标记为假，表明已经断开 直接返回
 
If IsConnect = False Then
 
Exit Sub
 
End If
 
关闭链接
 
空白n.Close
 
设置链接标记，表明已经断开链接
 
IsConnect = False
 
End Sub
 
'只用来执行Insert，update，delete语句
 
Public Sub sqlExt(tmpSql As String)
 
创建空白mand对象cmd
 
Dim cmd As New ADODB.Command
 
连接到数据库
 
DbConnect
 
设置cmd的ActiveConnection属性，指定其关联的数据库链接
 
Set cmd.ActiveConnection = 空白n
 
设置要执行的命令文本
 
cmd.CommandText = tmpSql
 
执行命令
 
cmd.Execute
 
清空cmd对象
 
Set cmd = noting
 
断开与数据库的连接
 
Db_Disconnect
 
End Sub
 
执行数据库查询程函数
 
Public Function QueryExt(tmpSql As String) As ADODB.Recordset
 
创建recordset对象rst
 
Dim rst As New ADODB.Recordset
 
链接到数据库
 
Db_Connect
 
设置rst的ActiveConnection属性，指定与其关联的数据库连接
 
Set rst.ActiveConnection = 空白n
 
设置游标类型
 
rst.CursorType = adOpenDynamic
 
设置锁定类型
 
rst.LockType = adLockOptimistic
 
打开记录集
 
rst.Open tmpSql
 
返回记录集
 
Set QueryExt = rst
 
End Function
 
VB中怎幺对数据库进行添加删除修改的操作
 
下面的例子就是对数据库进行添加删除修改的操作：
 
Private Sub Command1_Click()
 
For i = 0 To 5
 
Text1(i).Text = ""
 
Next i
 
Adodc1.RecordSource = "select * from " & s1 & " order by 编号"
 
Adodc1.Refresh
 
If Adodc1.Recordset.RecordCount > 0 Then
 
Adodc1.Recordset.MoveLast
 
Text1(0).Text = "G" + Format((Val(Right(Trim(Adodc1.Recordset.Fields("编号")), 4)) + 1), "0000")
 
Else
 
Text1(0).Text = "G0001"
 
End If
 
End Sub
 
Private Sub Command2_Click()
 
If Adodc1.Recordset.EOF = False Then
 
c = MsgBox("您确认要删除该记录吗？", vbOKCancel, "删除提示信息")
 
If c = vbOK Then
 
Adodc1.Recordset.Delete
 
Adodc1.RecordSource = "select * from 人员表"
 
Adodc1.Refresh
 
End If
 
Else
 
MsgBox "当前数据库中没有可删除的数据记录", vbOKOnly, "提示信息"
 
End If
 
End Sub
 
Private Sub Command3_Click()
 
If Text1(0).Text = "" Or Text1(1).Text = "" Then
 
MsgBox "请选择需要改动的记录信息！", vbOKOnly, "错误提示"
 
Else
 
c = MsgBox("确定要修改该记录吗？", vbOKCancel, "提示信息")
 
If c = vbOK Then '如果确认修改的话进行修改操作
 
If Text1(1).Text = "" Then
 
MsgBox "姓名不能为空值!", 48, "修改****"
 
Else
 
'连接所要修改的数据库
 
con.Open "Provider=SQLOLEDB.1;Password=2752;Persist Security Info=True;User ID=sa;Initial Catalog=sample;Data Source=JAMLEEPC"
 
'开始修改数据库
 
con.Execute ("UPDATE " & s1 & " SET 姓名='" & Text1(1).Text & "',年龄=" & Text1(2).Text & ",学历='" & Text1(3).Text & "',年级=" & Text1(4).Text & ", 入学时间='" & Text1(5).Text & "' where 编号='" & Trim(Text1(0)) & "'")
 
MsgBox "信息修改成功", 64, "修改****"
 
con.Close
 
Adodc1.RecordSource = "select * from 人员表"
 
Adodc1.Refresh
 
End If
 
End If
 
End If
 
End Sub
 
Private Sub Command4_Click()
 
Adodc1.RecordSource = "select * from 人员表 where 编号='" + Text1(0).Text + "'"
 
Adodc1.Refresh
 
If Adodc1.Recordset.RecordCount > 0 Then
 
MsgBox "该信息已存在，信息保存不成功", 64, "保存****"
 
Else
 
cc = MsgBox("您确定要保存该信息吗？", 33, "信息保存提示")
 
If cc = vbOK Then
 
If Text1(1).Text = "" Or Text1(2).Text = "" Or Text1(3).Text = "" Or Text1(4).Text = "" Or Text1(5).Text = "" Then
 
MsgBox "请确认，人员的姓名、年龄、学历、年级和入学时间不能为空", 48, "保存****"
 
Else
 
con.Open "Provider=SQLOLEDB.1;Password=2752;Persist Security Info=True;User ID=sa;Initial Catalog=sample;Data Source=JAMLEEPC"
 
con.Execute ("insert into 人员表 values('" & Text1(0).Text & "','" & Text1(1).Text & "','" & Text1(2).Text & "','" & Text1(3).Text & "','" & Text1(4).Text & "', '" & Text1(5).Text & "')")
 
MsgBox "信息修改成功", 64, "修改****"
 
con.Close
 
Adodc1.RecordSource = "select * from 人员表"
 
Adodc1.Refresh
 
End If
 
Else
 
End If
 
End If
 
Set DataGrid1.DataSource = Adodc1
 
End Sub
 
如何使用Delete语句从VB数据库删除信息？
 
用sql语句的删除命令：delete from (表名) where (条件)
 
举例如下：(最好系统学一下，因为不知道你用的什幺方法进行vb操作)
 
(我为推荐一本书，电大的计算机大专计算机信息方向的《VB程序设计》刘世峰编，通学习你一切都通了)
 
Private Sub Command1_Click()
 
'定义字符
 
Dim strSQL As String
 
'定义一个整型变量
 
Dim i As Integer
 
i = MSHFlexGrid1.Row
 
'处理无记录行
 
If MSHFlexGrid1.TextMatrix(i, 1) = "" Then
 
MsgBox "请选择一个记录！", vbQuestion + vbOKOnly, "信息提示"
 
Exit Sub
 
End If
 
'编定SQ查询语句
 
strSQL = "Delete From 通讯簿 "
 
strSQL = strSQL + "Where 姓名='" + MSHFlexGrid1.TextMatrix(i, 1) + "'"
 
'提示用户要谨慎删除
 
If MsgBox("是否要删除，请慎重！", vbQuestion + vbOKCancel, "信息提示") = vbOK Then
 
'执行删除命令
 
ADO空白.Execute strSQL
 
End If
 
DisplayGrid1
 
End Sub
 
利用VB来删除SQL中一行的数据,代码如何编写
 
sql="select * from tbluser where username='"&text1.text&"'"
 
rs.open sql,conn,1,3
 
rs.delete
 
VB.NET 里如何给SQL SERVER数据库插入记录和删除记录，插入字段，删除字段
 
使用 VB.NET 连接sqlserver执行sql命令会不会？ 不会的话去百度搜。
 
插入记录和删除记录，插入字段，删除字段 的sql语句会不会写？ 不会的话去百度搜。
 
用vb怎样删除sql server数据库中一条数据
 
简单说就是SQL语句中的引号问题。
 
SQL = "delete from Goods where GoodsName='" & Text2.Text & "'" + rsTable.Open SQL, pubConn, adOpenKeyset, adLockOptimistic
 
按你原来的写法，执行的SQL语句就是
 
delete from Goods where GoodsName='&Text2.Text&'
 
这里的Text2.Text被认为是字符串的一部分，不是变量了。
 
在vb中删除sqlserver中表的记录，我是想删除查询到底语句，如何实现
 
你的查询应该是有条件的，既然如此
 
用ado执行删除语句即可，条件就是查询的条件
 
示例：connection.Execute "delete from table where 条件"

 
要查找数据库信息，关键是要解决链接数据库的问题，下面简述Vb如何SQL数据库：
 
有两种方法可以实现，一种是通过ODBC数据源的配置进行连接，一种是通过纯代码编辑进行连接，下面我们就详细介绍一下这两种连接方法。
 
ODBC数据源VB连接SQL数据库
 
一、配置ODBC数据源
 
1、在控制面板中，双击管理工具，然后打开ODBC数据源管理器。
 
2、在“系统DSN”选项卡中，单击“添加”按钮，打开“创建新数据源”对话框，在“名称”列表框中选择“SQL Server”。选好单击完成
 
3、在打开“建立新的数据源到SQL Server”对话框，在“名称”文本框输入新数据源的名称，描述数据源按你理解的方式来写(随意)。“服务器”就选择你要连接到的服务器。
 
4、选择使用用户输入登录的ID和密码的SQL 验证。选连接SQL默认设置
 
5、再下一步下一步，完成。测试数据源看连接是否成功就行了。成功后按确定。
 
二、VB中设置连接
 
1、添加部件Mircrosoft ADO Data Control 6.0(OLEDB),把部件拖到窗体。
 
2、对ADO部件点右键选属性，选择使用连接字符串，按生成。
 
3、选择Mircosoft OLE DB Providar for SQL Server按下一步
 
4、
 
1)输入服务器名称
 
2)使用指定的服务器信息
 
3)在服务器上选择数据库
 
这时就选择你在SQL Server建好的数据库就行了
 
5、测试连接可以看到连接是否成功！
 
通过代码VB连接SQL数据库
 
Public conn As New ADODB.Connection
 
Public rs As New ADODB.Recordset
 
Public addFlag As Boolean
 
Public Function OpenCn(ByVal Cip As String) As Boolean
 
Dim mag As String
 
On Error GoTo strerrmag
 
Set conn = New ADODB.Connection
 
conn.ConnectionTimeout = 25
 
conn.Provider = "sqloledb"
 
conn.Properties("data source").Value = Cip '服务器的名字
 
conn.Properties("initial catalog").Value = "zqoa" '库名
 
'conn.Properties("integrated security").Value = "SSPI" '登陆类型
 
conn.Properties("user id").Value = "sa"
 
conn.Properties("password").Value = "sa"
 
conn.Open
 
OpenCn = True
 
addFlag = True
 
Exit Function
 
strerrmag:
 
mag = "Data can't connect"
 
Call MsgBox(mag, vbOKOnly, "Error:Data connect")
 
addFlag = False
 
Exit Function
 
End Function
 
Public Sub cloCn()
 
On Error Resume Next
 
If conn.State <> adStateClosed Then conn.Close
 
Set conn = Nothing
 
End Sub
 
Public Function openRs(ByVal strsql As String) As Boolean '连接数据库记录集
 
Dim mag As String
 
Dim rpy As Boolean
 
On Error GoTo strerrmag
 
Set rs = New ADODB.Recordset
 
If addFlag = False Then rpy = True
 
With rs
 
.ActiveConnection = conn
 
.CursorLocation = adUseClient
 
.CursorType = adOpenKeyset
 
.LockType = adLockOptimistic
 
.Open strsql
 
End With
 
addFlag = True
 
openRs = True
 
End
 
'Exit Function
 
strerrmag:
 
mag = "data not connect"
 
Call MsgBox(mag, vbOKOnly, "error:connect")
 
openRs = False
 
End
 
'Exit Function
 
End Function
 
Public Sub cloRs()
 
On Error Resume Next
 
If rs.State <> adStateClosed Then rs.Clone
 
Set rs = Nothing
 
End Sub
 
取消
 
评论