用EXCEL查询 SQL SERVER 数据库 U8 876的现存量。有重复的用黄色标记。

来源：互联网发布：手机看网络电视流量编辑：程序博客网时间：2024/06/09 14:33

年纪大了。发现知识是用来分享的。整天的在网上爬别人的经验。现在也希望能为这个网络留下一点自己的经验。先把EXCEL查询SQL SERVER 数据库的代码黏贴出来。当然，本人的方法并不是最好的，还有很多需要改进的地方。只为还在学习的同学一起学习交流而分享。代码都有注释，应该比较好看的懂。代码送上。

Public Function search_sql()        Dim I2 As Integer, j2 As Integer, sht As Worksheet     ' i2,j2为整数变量；sht 为excel工作表对象变量，指向某一工作表  Dim CR, JR, C, F, CFKG As Integer     'CR Excel表的需要查询的行序号，JRExcel表的得到的结果行序号， C  Excel表的列序号 F 查询结果的总记录数  I SQL表的字段序号  Dim strCn As String, strSQL As String '字符串变量                         '========================循环读取查询=====================================           CR = 2  '表示从第二行开始，行序号       JR = CR '表示从第二行开始，行序号       C = 1  '表示从第一列开始，列序号                                    '这里需要注意的是，如果用这一句，只能在当前工作表中正常使用。另存为宏后就不能正常工作了   'ThisWorkbook指的是当前工作簿，不是活动工作表。她就指向宏的工作簿了。        ' Set sht = ThisWorkbook.Worksheets("Sheet1")'把sht指向当前工作簿的Test工作表        '改用ActiveWorkbook就指向当前活动工作簿了。就能正常工作了。O(∩_∩)O哈哈~          Set sht = ActiveWorkbook.Worksheets("Sheet1") '把sht指向当前工作簿的Test工作表                                           Dim strA As String     '我定义的字符串变量名     ' Dim strB(10) As String     '我定义的字符串变量名          Dim length As Long, count As Long    ' zonglieshu = 1 To Worksheets(2).UsedRange.Rows.Count  '得到总的列数,本例中不适用。    ' length = sht.UsedRange.Columns.count '得到该列元素个数                 '=================唯一的缺点就是这句话还有问题，有时候多，有时候少的。===================              'length = sht.UsedRange.Rows.count '得到该列元素个数                   ' MaxRows = Range("A1").CurrentRegion.Rows.count          '统计行数       ' MaxCols = Range("A1").CurrentRegion.Columns.count       '统计列数                                length = Range("A1").CurrentRegion.Rows.count         '=========================================================================================                              For CR = 2 To length + 1                   'strA = Range("21").Value      strA = sht.Cells(CR, 1).Value      'strA = Worksheets("Sheet1").Cells(R, C).Value                              MsgBox ("共" & length & "行：第" & CR & "表格中的内容为：" & strA)                  If (strA = Null) Then             GoTo continue                           Else  '====================================                                                  '方法一：直接引入数据库驱动程序'工具 ---〉引用 ---〉Microsoft ActiveX data objects ....'然后定义两个驱动'Dim cn As New ADODB.Connection '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用'Dim rs As New ADODB.Recordset '定义记录集对象，保存数据表' Set cn = New ADODB.Connection' Set rs = New ADODB.Recordset      '方法二：不用引入驱动，直接设置驱动。   Dim cn As Object Dim rs As Object   'Dim cn As New ADODB.Connection   '数据库连接对象  'Dim rs As New ADODB.Recordset     '记录集对象  Set cn = CreateObject("Adodb.Connection") Set rs = CreateObject("Adodb.Recordset")   '=========================我用的是方法二======================''''                  '这里需要注意的是，如果用这一句，只能在当前工作表中正常使用。另存为宏后就不能正常工作了   'ThisWorkbook指的是当前工作簿，不是活动工作表。她就指向宏的工作簿了。        ' Set sht = ThisWorkbook.Worksheets("Sheet1")'把sht指向当前工作簿的Test工作表        '改用ActiveWorkbook就指向当前活动工作簿了。就能正常工作了。O(∩_∩)O哈哈~          'Set sht = ActiveWorkbook.Worksheets("Sheet1") '把sht指向当前工作簿的Test工作表                                      strCn = "Provider=sqloledb;Server=127.0.0.1;Database=CHAXUN_TEST;Uid=sa;Pwd=yangji903" '定义数据库链接字符串          '下面的语句将读取数据表数据，并将它保存到excel工作表中：工作表为一张两维表，记录集也是一张两维表         '  ConnectString = "FileDSN=student.dsn;UID=lee;PWD=123"                                              'MsgBox (strA) '弹出对话框，显示获得到的值             ' MsgBox "A1单元格的当前值为：" & length     '弹出对话框，显示获得到的值                  'For CR = 2 To length                                        'Worksheets(1).Cells(5, 5).Interior.ColorIndex = 6        'Cells(5, 5)该单元格变成黄色                       ' If Cells(i, 2) = "a" Then      '  Worksheets(1).Cells(i, 2).Interior.ColorIndex = 6        '当单元格＝"a"时该单元格变成黄色         'count = count + 1     ' End If   ' MsgBox (strA)                  'strSQL = "SELECT * FROM [dbo].[CurrentStock] " '定义SQL查询命令字符串        'strSQL = "SELECT top 100 * FROM [dbo].[CurrentStock] " '定义SQL查询命令字符串                'VB 的SQL查询语句，这个非常重要哦。        strSQL = "SELECT * FROM [dbo].[CurrentStock] where cInvCode = '" & strA & "'"               'sht.Cells(6, 7) = strA              cn.Open strCn '与数据库建立连接，如果成功，返回连接对象cn    rs.Open strSQL, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中                                          '测试用    'Dim a As String    'Dim b As String    'a = ActiveWorkbook.Name '返回活动工作薄的名称    'b = ThisWorkbook.Name   '返回当前工作簿名称    'MsgBox "程序被调用。" & a & "=====" & b           CFKG = 0 '表示查询到的结果是否重复，如果重复，底色变黄色。          Do While Not rs.EOF '当数据指针未移到记录集末尾时，循环下列操作              '================================现把背景色变白--------------        sht.Cells(JR, C + 1).Interior.ColorIndex = 2        '当单元格＝"a"时该单元格变成黄色        sht.Cells(JR, C + 2).Interior.ColorIndex = 2        '当单元格＝"a"时该单元格变成黄色        sht.Cells(JR, C + 3).Interior.ColorIndex = 2       '当单元格＝"a"时该单元格变成黄色                              sht.Cells(JR, C + 1) = rs("cInvCode") '把当前记录的字段1的值保存到sheet1工作表的第I行第C+1列      sht.Cells(JR, C + 2) = rs("iQuantity") '把当前记录的字段1的值保存到sheet1工作表的第I行第C+2列      sht.Cells(JR, C + 3) = rs("ItemId") '把当前记录的字段1的值保存到sheet1工作表的第I行第C+3列      'sht.Cells(R, C + 3) = rs("waijing") '把当前记录的字段1的值保存到sheet1工作表的第I行第1列      'sht.Cells(R, C + 4) = rs("zifuchuan") '把当前记录的字段1的值保存到sheet1工作表的第I行第1列      'sht.Cells(R, C + 5) = rs("riqi") '把当前记录的字段1的值保存到sheet1工作表的第I行第1列      'sht.Cells(R, C + 6) = rs("shijian") '把当前记录的字段1的值保存到sheet1工作表的第I行第1列      'sht.Cells(R, C + 7) = rs("text") '把当前记录的字段1的值保存到sheet1工作表的第I行第1列                                                                          '遍历该列单元格      If CFKG > 0 Then              'Worksheets(1).Cells(JR, 2).Interior.ColorIndex = 6        '当单元格＝"a"时该单元格变成黄色                sht.Cells(JR, C + 1).Interior.ColorIndex = 6        '当单元格＝"a"时该单元格变成黄色        sht.Cells(JR, C + 2).Interior.ColorIndex = 6        '当单元格＝"a"时该单元格变成黄色        sht.Cells(JR, C + 3).Interior.ColorIndex = 6        '当单元格＝"a"时该单元格变成黄色                  End If                                      rs.MoveNext '把指针移向下一条记录                  JR = JR + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行      CFKG = CFKG + 1          Loop '循环 Do While Not rs.EOF               rs.Close '关闭记录集，至此，程序将把某数据的字段1保存在工作表sheet1的第1列，行数等于数据表的记录数    Set rs = Nothing    cn.Close '关闭数据库连接，释放资源    Set cn = Nothing                           End Ifcontinue:  ' CR = CR + 1            Next CR = CR + 1          'CR = CR + 1                End Function<pre name="code" class="html">

再在表格一内添加一个按钮。代码如下

Private Sub CommandButton1_Click()    Call search_sql      End Sub

效果如图：

好了。效果就是这样的。主要是用来解决想要查的存货编码太多，U8又不能批量查询。所以写这个可以帮助批量查询。本想直接上传文件，可惜不知道在哪上传。

0 0