如何对Excel 宏 按照数据库的方式统计分析

Dim IsSourceWS As Boolean

Dim isTable1 As Boolean

Dim isTable2 As Boolean

Dim isTable3 As Boolean

IsSourceWS = False

isTable1 = False

isTable2 = False

isTable3 = False

sStartPath = ActiveWorkbook.Path & "/" & ActiveWorkbook.Name

If Worksheets.Count = 0 Then

Exit Sub

Else

For Each EacheWorksheet In Worksheets

If EacheWorksheet.Name = "原表" Then

IsSourceWS = True

Else

If EacheWorksheet.Name = "表1" Then

isTable1 = True

Else

If EacheWorksheet.Name = "表2" Then

isTable2 = True

Else

If EacheWorksheet.Name = "表3" Then

isTable3 = True

End If

End If

End If

End If

Next EacheWorksheet

End If

'*******************************没有原表则提示****************************************************

If IsSourceWS = False Then

MsgBox "没有发现命名为'原表'的Sheet页签，请核对"

Exit Sub

End If

'*********************************对Table1进行判断************************************************

If isTable1 = True Then

Application.DisplayAlerts = False

Worksheets("表1").Delete

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表1"

Worksheets("表1").Move after:=Sheets(Sheets.Count)

Else

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表1"

Worksheets("表1").Move after:=Sheets(Sheets.Count)

End If

'*********************************对Table2进行判断************************************************

If isTable2 = True Then

Application.DisplayAlerts = False

Worksheets("表2").Delete

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表2"

Worksheets("表2").Move after:=Sheets(Sheets.Count)

Else

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表2"

Worksheets("表2").Move after:=Sheets(Sheets.Count)

End If

'*********************************对Table3进行判断*****************************************************

If isTable3 = True Then

Application.DisplayAlerts = False

Worksheets("表3").Delete

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表3"

Worksheets("表3").Move after:=Sheets(Sheets.Count)

Else

Set AddWorksheet = Nothing

Set AddWorksheet = Worksheets.Add

AddWorksheet.Name = "表3"

Worksheets("表3").Move after:=Sheets(Sheets.Count)

End If

'****************************************************连接数据库驱动************************************

lcconectionstring = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & sStartPath & ";" & _

"Extended Properties=Excel 8.0;"

lccommandtext = "SQL语句"

Set loadodbconection = CreateObject("adodb.connection")

Set loadodbrecordset = CreateObject("adodb.recordset")

loadodbconection.Open lcconectionstring

loadodbrecordset.Open lccommandtext, loadodbconection, 3, 1, 1

Dim r As Integer

Dim f As Integer

r = 1

Application.DisplayAlerts = False

Application.StatusBar = "正在执行数据统计分析中,请稍后......."

'*****************************************************************************************

'**********************************提高速度，采用按行写入**********************************

'*****************************************************************************************

ReDim RowInfo(5) As String

For f = 0 To loadodbrecordset.Fields.Count - 1

RowInfo(f) = loadodbrecordset.Fields(f).Name

Next

RowInfo(f) = "备注"

Sheets("表2").Select

Sheets("表2").Range(Cells(r, 1), Cells(r, f + 1)).Value2 = RowInfo

ReDim RowInfo(5) As String

If loadodbrecordset.PageCount = 0 Then

Application.StatusBar = ""

Exit Sub

End If

While Not loadodbrecordset.EOF

r = r + 1

For f = 0 To loadodbrecordset.Fields.Count - 1

RowInfo(f) = loadodbrecordset.Fields(f).Value

Next

Sheets("表2").Range(Cells(r, 1), Cells(r, f + 1)).Value2 = RowInfo

Sheets("表2").Cells(r, f + 1) = "备注一下"

loadodbrecordset.MoveNext

Wend

Sheets("表2").Cells.EntireColumn.AutoFit

'*****************************************************************************