在SQL Server中轻松使用Excel数据

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

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

我将此例程绑定到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

我发现,当我必须使用包含不确定格式数据的电子表格时,我往往会突然出现皮疹,这种格式可能会随着时间的推移而变化。

对代码的几点观察:

与…同时 Application.WorksheetFunction.Substitute VB/VBA具有 Replace 函数,稍微简洁一点。从性能的角度来看,这可能不是特别重要,但通常应该尝试参考 Application 对象或 Workbook/Worksheets 在代码中尽可能少,因为从代码到应用程序的往返成本往往会加起来。因此,当迭代一个 Range ,通常将值加载到 Variant ,如

Dim values as Variant
values = Selection.Values

并在数组上循环,以消除每次引用时的往返 .Cells .

我有点厌倦了 theXML = theXML & -很难看出发生了什么。你可以考虑写一个小的StringBuilder类,这样你就可以减少

 theXML = theXML & "INTO #tmp"

向

 sb.Add "INTO #tmp"

Add方法可以处理所有这些 & vbCrLf 商业也是如此,坦率地说,这将是一件幸事。

也就是说,我想知道需要定期进行此类检查的业务流程。是否打算确保两地的数据相同?重复/协调通常是一个需要重构的过程的标志。如果你在寻找差异,是否有更好的方法来记录它们?如何更改内容,使数据只能在数据库中更改?只是想知道。。。