在SQL Server中轻松使用Excel数据

我经常需要比较Excel电子表格中发送给我的数据和SQL Server中的数据。 我知道你可以将SQL Server连接到电子表格,但总是显得笨重

这真是一个展示我的解决scheme的post,但我很想听听其他人的想法。

为获得最佳效果,请将以下代码粘贴到personal.xls文件中的模块中。 您将需要添加对Microsoft Forms 2.0对象库的引用。

当你运行这个例程时,它会使用当前突出显示的区域并创build一个XMLstring。 它还创buildTSQL将该XML转换为名为#tmp的临时表。 它也将TSQL粘贴到剪贴板中。 它做了很多的假设,默认的临时表都是VARCHAR(100)。

我把这个例程绑定到Cntl-Shift-X。

最终的结果是,如果我突出显示一个Reagion(带标题),单击Cntl-Shift-X,并进入查询窗口,我可以立即访问SQL中的电子表格数据。

我节省了很多时间。

欢迎提出改进build议:o)

Sub CreateOpenXML() Dim cols, rows As Long cols = Selection.Columns.Count rows = Selection.rows.Count Dim Header() As String ReDim Preserve Header(cols) For i = 1 To cols '''Each Column In Selection.Rows(0).Columns Header(i) = CleanHeader(Selection.Cells(1, i).Value) 'Header(i) = Application.WorksheetFunction.Substitute(CleanString(Selection.Cells(1, i).Value), " ", "_") 'Header(i) = Application.WorksheetFunction.Substitute(Header(i), "(", "_") 'Header(i) = Application.WorksheetFunction.Substitute(Header(i), ")", "_") 'i = i + 1 Next Dim theXML As String, tmpXML As String, counter As Integer theXML = "DECLARE @DocHandle int" & vbCrLf theXML = theXML & "DECLARE @XmlDocument varchar(8000)" & vbCrLf theXML = theXML & "EXEC sp_xml_preparedocument @DocHandle OUTPUT, N'<theRange>" & vbCrLf tmpXML = "" counter = 0 For i = 2 To rows tmpXML = tmpXML & vbTab & "<theRow>" For j = 1 To cols If Selection.Cells(i, j).Text <> "NULL" And Selection.Cells(i, j).Text <> "" Then tmpXML = tmpXML & "<" & Header(j) & ">" & CleanString(Selection.Cells(i, j).Text) & "</" & Header(j) & ">" 'tmpXML = tmpXML & CleanString(Selection.Cells(i, j).Text) 'tmpXML = tmpXML & "</" & Header(j) & ">" End If Next j tmpXML = tmpXML & "</theRow>" & vbCrLf counter = counter + 1 If counter = 200 Then theXML = theXML & tmpXML tmpXML = "" counter = 0 End If Next i theXML = theXML & tmpXML theXML = theXML & "</theRange>'" & vbCrLf & vbCrLf '''theXML = theXML & "EXEC sp_xml_preparedocument @DocHandle OUTPUT, @XmlDocument" & vbCrLf theXML = theXML & "SELECT " For i = 1 To cols theXML = theXML & "[" & Header(i) & "]" If i <> cols Then theXML = theXML & ", " Next theXML = theXML & vbCrLf theXML = theXML & "INTO #tmp" theXML = theXML & vbCrLf theXML = theXML & "FROM OPENXML (@DocHandle, '/theRange/theRow',2) WITH (" & vbCrLf For i = 1 To cols theXML = theXML & vbTab & "[" & Header(i) & "] varchar(100)" If i <> cols Then theXML = theXML & "," theXML = theXML & vbCrLf Next theXML = theXML & ")" & vbCrLf theXML = theXML & "EXEC sp_xml_removedocument @DocHandle" & vbCrLf theXML = theXML & vbCrLf theXML = theXML & "Select * from #tmp" & vbCrLf theXML = theXML & vbCrLf theXML = theXML & "--DROP TABLE #tmp" theXML = theXML & vbCrLf MsgBox "The XML has been copied to the clipboard" Dim dob As New DataObject dob.SetText (theXML) dob.PutInClipboard End Sub Function CleanString(orig As String) Dim tmp As String tmp = orig '''MsgBox InStr(orig, "&") If InStr(orig, "&") > 0 Or InStr(orig, "'") > 0 Or InStr(orig, "<") > 0 Or InStr(orig, ">") > 0 Or InStr(orig, """") > 0 Then tmp = Application.WorksheetFunction.Substitute(tmp, "&", "&amp;") tmp = Application.WorksheetFunction.Substitute(tmp, "'", "&apos;") tmp = Application.WorksheetFunction.Substitute(tmp, "<", "&lt;") tmp = Application.WorksheetFunction.Substitute(tmp, ">", "&gt;") tmp = Application.WorksheetFunction.Substitute(tmp, """", "&quot;") End If CleanString = tmp End Function Function CleanHeader(orig As String) Dim tmp As String tmp = Trim(orig) If InStr(orig, " ") > 0 Or InStr(orig, "(") > 0 Or InStr(orig, ")") > 0 Or InStr(orig, "$") > 0 Or InStr(orig, "/") > 0 Or InStr(orig, "?") > 0 Or InStr(orig, "&") > 0 Or InStr(orig, "'") > 0 Or InStr(orig, "<") > 0 Or InStr(orig, ">") > 0 Or InStr(orig, """") > 0 Then tmp = Application.WorksheetFunction.Substitute(tmp, "&", "And") tmp = Application.WorksheetFunction.Substitute(tmp, "'", "_") tmp = Application.WorksheetFunction.Substitute(tmp, "<", "") tmp = Application.WorksheetFunction.Substitute(tmp, ">", "") tmp = Application.WorksheetFunction.Substitute(tmp, """", "") tmp = Application.WorksheetFunction.Substitute(tmp, " ", "_") tmp = Application.WorksheetFunction.Substitute(tmp, "(", "_") tmp = Application.WorksheetFunction.Substitute(tmp, ")", "_") tmp = Application.WorksheetFunction.Substitute(tmp, "$", "") tmp = Application.WorksheetFunction.Substitute(tmp, "/", "") tmp = Application.WorksheetFunction.Substitute(tmp, "?", "") End If CleanHeader = tmp End Function Sub MakeText() ActiveCell.CurrentRegion.Select Dim rng As Range Set rng = Selection Dim str As String For i = 1 To rng.rows.Count For j = 1 To rng.Columns.Count str = Application.WorksheetFunction.Text(rng.Cells(i, j).Value, "#") rng.Cells(i, j).NumberFormat = "@" rng.Cells(i, j).Value = str Next j Next i End Sub 

如上所示,这里是一个例子。 考虑这个电子表格数据:

 Name DOB Score Comment John Smith 7/1/1990 93 Great effort Sue Jones 1/1/1989 95 Super achievement Robin Sixpack 12/1/1985 100 OK 

此方法将生成以下TSQL:

 DECLARE @DocHandle int DECLARE @XmlDocument varchar(8000) EXEC sp_xml_preparedocument @DocHandle OUTPUT, N'<theRange> <theRow><Name>John Smith</Name><DOB>7/1/1990</DOB><Score>93</Score><Comment>Great effort</Comment></theRow> <theRow><Name>Sue Jones</Name><DOB>1/1/1989</DOB><Score>95</Score><Comment>Super achievement</Comment></theRow> <theRow><Name>Robin Sixpack</Name><DOB>12/1/1985</DOB><Score>100</Score><Comment>OK</Comment></theRow> </theRange>' SELECT [Name], [DOB], [Score], [Comment] INTO #tmp FROM OPENXML (@DocHandle, '/theRange/theRow',2) WITH ( [Name] varchar(100), [DOB] varchar(100), [Score] varchar(100), [Comment] varchar(100) ) EXEC sp_xml_removedocument @DocHandle Select * from #tmp --DROP TABLE #tmp 

当我不得不使用包含可能随时间变化的不确定格式的数据的电子表格时,我发现我倾向于冒险。

关于代码的一些观察:

虽然Application.WorksheetFunction.Substitute做的工作,VB / VBA具有Replacefunction,这是一个更简洁一点。 从性能angular度来看,这可能并不是特别重要,但是通常应该尽量在代码中尽可能less地引用Application对象或Workbook/Worksheets ,因为从代码到应用程序往返的成本往往加起来。 出于这个原因,当遍历一个Range ,将值加载到Variant通常是很有意义的,例如

 Dim values as Variant values = Selection.Values 

并循环遍历数组以消除每次引用时的往返行程.Cells

我对theXML = theXML &感到有点无聊 – 很难看到发生了什么事情。 你可能会考虑写一个StringBuilder类,所以你可以减less

  theXML = theXML & "INTO #tmp" 

  sb.Add "INTO #tmp" 

Add方法也可以处理所有的& vbCrLf业务,坦率地说,这将是一个祝福。

也就是说,我想知道需要定期检查的业务stream程。 是否有意确保两地的数据相同? 复制/和解常常是需要重构的过程的标志。 如果你正在寻找差异,可能有更好的方法来logging它们吗? 如何更改数据,以便数据只能在数据库中更改? 就是想…