我经常需要将Excel电子表格中发送给我的数据与SQL Server中的数据进行比较。我知道你可以将SQL Server连接到电子表格，但它总是显得很笨拙
这是一个展示我的解决方案的帖子，但我很想听听其他人的想法。
答案 0 :(得分：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, "&", "&")
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
答案 1 :(得分：1)
我发现当我不得不处理包含可能随时间变化的不确定格式的数据的电子表格时，我倾向于突然出现。
关于代码的几点意见：
当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业务，坦白说，这将是一种祝福。
那就是说，我想知道需要定期检查这种业务流程。是否有意确保两个地方的数据相同？复制/协调通常是需要进行一些重构的过程的标志。如果您正在寻找差异，可能有更好的方法来记录它们吗？如何更改内容以便只能在数据库中更改数据？只是想知道...