|
这是实际工作的问题,本人想通过VBA来解决,编程难度应该不是很大,但本人VBA编程能力有限,想求助各位大神帮忙。详细问题可见附件,可将已编程好的附件上传至下方或发送至本人邮箱,不胜感谢!
本帖最后由 xdragon 于 2014-9-23 23:07 编辑
- Sub test()
- Dim conn As Object, i%, sr$(1 To 4), sql$, rngarea$
- Set conn = CreateObject("adodb.connection")
- conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
- rngarea = Range("A2:M" & Cells(Rows.Count, 1).End(xlUp).Row).Address(0, 0)
- sr(1) = [r1]
- sr(2) = [t1]
- sr(3) = [w1]
- sr(4) = [z1]
- If Len(sr(1)) Then sql = sql & " and 年份>='" & sr(1) & "'"
- If Len(sr(2)) Then sql = sql & " and 年份<='" & sr(2) & "'"
- If Len(sr(3)) Then sql = sql & " and 行业='" & sr(3) & "'"
- If Len(sr(4)) Then sql = sql & " and 应用类型 like '%" & sr(4) & "%'"
- sql = IIf(Len(Mid(sql, 5)), " where" & Mid(sql, 5), "")
- If Cells(Rows.Count, "P").End(xlUp).Row > 2 Then Range("P3:AB" & Cells(Rows.Count, "P").End(xlUp).Row).Clear
- Range("P3").CopyFromRecordset conn.Execute("select * from [源文件$" & rngarea & "]" & sql)
- Range("P3:AB" & Cells(Rows.Count, "P").End(xlUp).Row).Borders.LineStyle = 1
- End Sub
复制代码
|
|