VBA+SQL+ Excel

VBA梳理：举一反三，处理方法只要改变个方式就可以！

1.连接数据库：

Dim sht As Worksheet, i As Long, j As Integer, k As Integer 'j为整数变量；sht 为excel工作表对象变量，指向某一工作表

Dim cn As New ADODB.Connection '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用

Dim rs As New ADODB.Recordset '定义记录集对象，保存数据表

Dim strCn As String, strSQL As String '字符串变量

strCn = "Provider=sqloledb;Server=0.0.0.0;Database=XMDEV;Uid=sa1;Pwd=529780;" '定义数据库链接字符串

strSQL = "select MARA_MATNR as '主件品号',MAKT_MAKTX as '主件品名',MARA_WRKST as '主件规格'from INVMB where MARA_MATNR='" & Cells(i, 1) & "'" '定义SQL查询命令字符串"-----根据一定的条件抓数据

cn.Open strCn '与数据库建立连接，如果成功，返回连接对象cn

rs.Open strSQL, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

2. 数据导入Excel:

//循环Excel表，并在对应的单元格导入数据

For Each myrange1 In Range("E3:E200")

'If myrange1.Value <> "" Then

'Cells(i, 5) = myrange1.Value

strSQL = "select MARA_MATNR as '元件品号',MAKT_MAKTX as '元件品名',MARA_WRKST as '元件规格',MARA_MEINS as '单位',MARC_KAUSF as '报废',MARC_SOBSL as '特殊采购',MARC_MMSTA as '特定工厂的物料状态' from INVMB where MARA_MATNR='" & Cells(i, 5) & "'"

rs.Open strSQL, cn

Set sht = ThisWorkbook.Worksheets("BOM建立申请")

//判断从数据库抓出来填充的数据集是否为空

If rs.EOF And rs.BOF Then

rs.Close

sht.Cells(i, 4) = ""

sht.Cells(i, 5) = ""

sht.Cells(i, 6) = ""

sht.Cells(i, 7) = ""

sht.Cells(i, 8) = ""

sht.Cells(i, 9) = ""

sht.Cells(i, 10) = ""

sht.Cells(i, 11) = ""

sht.Cells(i, 12) = ""

sht.Cells(i, 13) = ""

sht.Cells(i, 20) = ""

sht.Cells(i, 21) = ""

rs.MoveNext '把指针移向下一条记录

i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行

Exit Sub

Else

//单元格格数据是否重复判断，并在满足条件的单元格染色处理

For j = i + 1 To 199

If Cells(i, 5) = Cells(j, 5) Then

Cells(j, 5).Interior.ColorIndex = 3

'Else

'Cells(i, 5).Interior.ColorIndex = 2

End If

If Cells(j, 5) = "" Then

Exit For

End If

Next j

sht.Cells(i, 6) = rs("元件品名")

//统计不同列单元格数据是否相等，并在满足条件的单元格染色处理

If Cells(i, 11) = "" Then

Cells(i, 8).Interior.ColorIndex = 2

ElseIf Cells(i, 8) >= Len(Cells(i, 11)) - Len(Application.WorksheetFunction.Substitute(Cells(i, 11), ",", "")) + 1 Then

Cells(i, 8).Interior.ColorIndex = 2

Else

Cells(i, 8).Interior.ColorIndex = 3

End If

For k = i + 1 To 199

If Cells(i, 11) = Cells(k, 11) Then

Cells(k, 11).Interior.ColorIndex = 3

End If

If Cells(k, 11) = "" Then

Cells(k, 11).Interior.ColorIndex = 2

Exit For

End If

Next k

rs.MoveNext '把指针移向下一条记录

i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行

End If

rs.Close '关闭记录集，至此，程序将把某数据表的字段1和字段2保存在excel工作表sheet1的第1、2列，行数等于数据表的记录数

cn.Close '关闭数据库链接,释放资源

End If

Else

Exit Sub

End If

Next