实例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