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

这确实是一个炫耀我的解决方案的帖子，但我很想听听其他人的想法。

最佳答案

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

当您运行此例程时，它会获取当前突出显示的区域并创建一个 XML 字符串。它还创建 TSQL 以将该 XML 转换为名为#tmp 的临时表。它还会将 TSQL 粘贴到剪贴板中。它做了很多假设，默认的临时表都是VARCHAR(100)。

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

最终结果是，如果我突出显示一个区域(带标题)，单击 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

关于xml - 在 SQL Server 中轻松使用 Excel 数据，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/344845/