我經常需要將Excel電子表格中發送給我的數據與生活在SQL Server中的數據進行比較。我知道你可以將SQL Server連接到電子表格,但它總是顯得笨拙在SQL Server中輕鬆使用Excel數據
這真是一個展示我的解決方案的帖子,但我很想聽聽其他人的想法。
我經常需要將Excel電子表格中發送給我的數據與生活在SQL Server中的數據進行比較。我知道你可以將SQL Server連接到電子表格,但它總是顯得笨拙在SQL Server中輕鬆使用Excel數據
這真是一個展示我的解決方案的帖子,但我很想聽聽其他人的想法。
爲了獲得最佳效果,請將以下代碼粘貼到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, "&", "&")
tmp = Application.WorksheetFunction.Substitute(tmp, "'", "'")
tmp = Application.WorksheetFunction.Substitute(tmp, "<", "<")
tmp = Application.WorksheetFunction.Substitute(tmp, ">", ">")
tmp = Application.WorksheetFunction.Substitute(tmp, """", """)
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
迭代時,它通常是良好的意識,在
Dim values as Variant
values = Selection.Values
和循環陣列上的值加載到一個Variant
,因爲每次你引用.Cells
時間來消除往返。
我有點無聊theXML = theXML &
- 很難看到發生了什麼。你可能會考慮寫一點點StringBuilder類,比如說,讓你可以減少
theXML = theXML & "INTO #tmp"
到
sb.Add "INTO #tmp"
Add方法可以處理所有& vbCrLf
企業也是如此,這將坦率地說,是福。
這就是說,我想知道需要定期檢查這種類型的業務流程。是否有意確保兩地的數據相同?複製/和解通常是需要重構的過程的標誌。如果你正在尋找差異,可能有更好的方法來記錄它們嗎?如何更改數據,以便只能在數據庫中更改數據?只是想知道...
你能證明生成的結果可能看起來像,只是爲了舉例嗎?僅供參考 - 這是一個很棒的例子,並且會成爲一篇很棒的博客文章! – 2008-12-05 19:30:35
謝謝米切爾!告訴你的朋友。它是一個很棒的工具,我爲它感到自豪,儘管我打算進行邁克上面提到的幾項改變。 – wcm 2008-12-08 13:52:20