实例39将日期转换为文本

　　实例39-多个工作表指定区域单元格统计
　　Private Sub CommandButton获取_Click()
　　＂获取工作簿中包含的工作表
　　With ThisWorkbook.Worksheets(＂统计结果＂) ＂清除原列表数据
　　.UsedRange.ClearFormats
　　.UsedRange.ClearContents
　　End With
　　Dim wbname As String
　　Dim findrange As String
　　With ThisWorkbook.Worksheets(＂操作界面＂)
　　If .Cells(2, ＂C＂).Value <> ＂＂ Then
　　wbname = .Cells(2, ＂C＂).Value
　　Else
　　MsgBox ＂请输入工作簿名称（包含扩展名）＂
　　Exit Sub
　　End If
　　If .Cells(5, ＂C＂).Value <> ＂＂ Then
　　findrange = .Cells(5, ＂C＂).Value
　　Else
　　MsgBox ＂请输入查询的区域地址＂
　　Exit Sub
　　End If
　　End With
　　Dim i As Integer
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 1).Value = ＂名称＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 2).Value = ＂区域＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 3).Value = ＂日期单元格数量＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 4).Value = ＂数值单元格数量＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 5).Value = ＂空单元格数量＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 6).Value = ＂文本单元格数量＂
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(1, 7).Value = ＂全部单元格数量＂
　　Dim j, cellitem
　　Dim numcount As Long
　　Dim nullcount As Long
　　Dim strcount As Long
　　Dim datecount As Long
　　For i = 1 To Workbooks(wbname).Worksheets.Count
　　numcount = 0
　　nullcount = 0
　　datecount = 0
　　With Workbooks(wbname).Worksheets(i)
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 1).Value = .Name
　　For Each cellitem In .Range(findrange)
　　If cellitem = ＂＂ Then
　　nullcount = nullcount + 1
　　Else
　　If IsNumeric(cellitem) = True Then
　　numcount = numcount + 1
　　End If
　　If IsDate(cellitem) = True Then
　　datecount = datecount + 1
　　End If
　　End If
　　Next cellitem
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 2).Value = findrange
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 3).Value = datecount
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 4).Value = numcount
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 5).Value = nullcount
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 6).Value = .Range(findrange).Cells.Count - datecount - numcount - nullcount
　　ThisWorkbook.Worksheets(＂统计结果＂).Cells(i + 1, 7).Value = .Range(findrange).Cells.Count
　　End With
　　Next i
　　ThisWorkbook.Worksheets(＂统计结果＂).Activate
　　End Sub实例40-将日期转换为文本
　　Private Sub CommandButton处理_Click()
　　With Worksheets(＂处理结果＂)
　　.Columns(2).ClearContents
　　.Columns(3).ClearContents
　　.Columns(4).ClearContents
　　.Columns(5).ClearContents
　　.Columns(6).ClearContents
　　Dim datey As Long
　　Dim datem As Long
　　Dim dated As Long
　　For i = 1 To .Range(＂A1000000＂).End(xlUp).Row
　　If .Cells(i, 1) <> ＂＂ And IsDate(.Cells(i, 1)) = True Then
　　datey = Year(.Cells(i, 1))
　　datem = Month(.Cells(i, 1))
　　dated = Day(.Cells(i, 1))
　　.Cells(i, 2) = ＂＂＂ & datey & ＂/＂ & datem & ＂/＂ & dated
　　.Cells(i, 3) = datey
　　.Cells(i, 4) = datem
　　.Cells(i, 5) = dated
　　.Cells(i, 6) = ＂＂＂ & datey & ＂年＂ & datem & ＂月＂ & dated & ＂日＂
　　End If
　　Next i
　　.Activate
　　End With
　　End Sub