2008-12-05 42 views
3

我經常需要將Excel電子表格中發送給我的數據與生活在SQL Server中的數據進行比較。我知道你可以將SQL Server連接到電子表格,但它總是顯得笨拙在SQL Server中輕鬆使用Excel數據

這真是一個展示我的解決方案的帖子,但我很想聽聽其他人的想法。

回答

3

爲了獲得最佳效果,請將以下代碼粘貼到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 
+0

你能證明生成的結果可能看起來像,只是爲了舉例嗎?僅供參考 - 這是一個很棒的例子,並且會成爲一篇很棒的博客文章! – 2008-12-05 19:30:35

+0

謝謝米切爾!告訴你的朋友。它是一個很棒的工具,我爲它感到自豪,儘管我打算進行邁克上面提到的幾項改變。 – wcm 2008-12-08 13:52:20

1

我發現我傾向於打破了皮疹,當我有在一個不確定的格式包含數據的電子表格的工作這可能會隨着時間而改變。

一對夫婦碼觀測的:

雖然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企業也是如此,這將坦率地說,是福。

這就是說,我想知道需要定期檢查這種類型的業務流程。是否有意確保兩地的數據相同?複製/和解通常是需要重構的過程的標誌。如果你正在尋找差異,可能有更好的方法來記錄它們嗎?如何更改數據,以便只能在數據庫中更改數據?只是想知道...

相關問題