在SQL Server中轻松使用Excel数据

Question

我经常需要将Excel电子表格中发送给我的数据与生活在SQL Server中的数据进行比较。我知道你可以将SQL Server连接到电子表格，但它总是显得笨拙

这真是一个展示我的解决方案的帖子，但我很想听听其他人的想法。

Answer 1

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

运行此例程时，它将采用当前突出显示的区域并创建一个XML字符串。它还创建TSQL将该XML转换为名为#tmp的临时表。它也将TSQL粘贴到剪贴板中。它做了很多假设，默认临时表全部是VARCHAR（100）。

我将此例程绑定到Cntl-Shift-X。

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

我节省了不少时间。

改进建议，欢迎：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 

Answer 2

我发现我倾向于打破了皮疹，当我有在一个不确定的格式包含数据的电子表格的工作这可能会随着时间而改变。

一对夫妇码观测的：

虽然Application.WorksheetFunction.Substitute做工作，VB/VBA具有Replace功能，这是一个小更简洁。从性能角度来看，这可能并不是特别重要，但应该尽量在代码中尽可能少地引用Application对象或Workbook/Worksheets，因为从代码到应用程序的往返行程的成本往往会增加向上。出于这个原因，跨Range迭代时，它通常是良好的意识，在

Dim values as Variant 
values = Selection.Values 

和循环阵列上的值加载到一个Variant，因为每次你引用.Cells时间来消除往返。

我有点无聊theXML = theXML & - 很难看到发生了什么。你可能会考虑写一点点StringBuilder类，比如说，让你可以减少

theXML = theXML & "INTO #tmp" 

到

sb.Add "INTO #tmp" 

Add方法可以处理所有& vbCrLf企业也是如此，这将坦率地说，是福。

这就是说，我想知道需要定期检查这种类型的业务流程。是否有意确保两地的数据相同？复制/和解通常是需要重构的过程的标志。如果你正在寻找差异，可能有更好的方法来记录它们吗？如何更改数据，以便只能在数据库中更改数据？只是想知道...