尝试根据列将电子表格拆分为多个时遇到错误 [英] Run into error while trying to split a spreadsheet into multiple based on a column

问题描述

我正在尝试将包含不同人信息的Excel电子表格拆分为包含单个人信息的不同电子表格。我从网站上获得了一些VBA代码，但在我尝试运行代码时遇到了错误。错误代码是条件表达式中的数据类型不匹配，有问题的代码是.Range（A2）。CopyFromRecordset conn.Execute（Sql）



有谁可以帮我这个？非常感谢你！



我的尝试：



< pre lang =vb> Sub CFGZB（）
Dim myRange As Variant
Dim myArray
< span class =code-keyword> Dim titleRange As 范围
Dim title As String
Dim columnNum As Integer
myRange = Application.InputBox（prompt：= 选择标题行，类型：= 8）
myArray = WorksheetFunction.Transpose（myRange）
< span class =code-keyword>设置 titleRange = Application.InputBox（提示：= 选择列，类型：= 8）
title = titleRange.Value
columnNum = titleRange.Column
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim i&，Myr&，Arr，num&
Dim d，k
对于 i = Sheets.Count 1 步骤 -1
如果表格（i）.Name<> 信息 然后
表格（i）。删除
结束 如果
下一步 i
设置 d = CreateObject（ Scripting.Dictionary）
Myr =工作表（ 信息）。UsedRange.Rows.Count
Arr =工作表（ 信息）。范围（单元格（ 2 ，columnNum），单元格（Myr，columnNum））
For i = 1 UBound（Arr）
d（Arr（i， 1 ））=
下一步
k = d.keys
对于 i = 0 到 UBound（k）
< span class =code-keyword>设置 conn = CreateObject（ adodb.connection）
conn.Open provider = microsoft.jet.oledb.4.0; extended properties = excel 8.0;数据源=& ThisWorkbook.FullName
Sql = select * from [Information $] where&标题& ='& k（i）& '
Worksheets.Add after：= Sheets（Sheets.Count）
使用 ActiveSheet
.Name = k（i）
对于 num = < span class =code-digit> 1 UBound（myArray）
.Cells（ 1 ，num）= myArray（num， 1 ）
下一页 num
' 此行似乎有错误
.Range（ A2）。CopyFromRecordset conn.Execute（Sql）

结束 使用
表格（ 1 ）。选择
表格（ 1 ）。单元格。选择
Selection.Copy
工作表（表格） .Count）。激活
ActiveSheet.Cells。选择
Selection.PasteSpecial粘贴：= xlPasteFormats，操作：= xlNone，SkipBlanks：= False， Transpose：= False
Application.CutCopyMode = False
Next i
conn.Close
Set conn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
结束 Sub

解决方案

where &安培;标题& ='& k（i）& '
Worksheets.Add after：= Sheets（Sheets.Count）
使用 ActiveSheet
.Name = k（i）
对于 num = < span class =code-digit> 1 UBound（myArray）
.Cells（ 1 ，num）= myArray（num， 1 ）
下一页 num
' 此行似乎有错误
.Range（ A2）。CopyFromRecordset conn.Execute（Sql）

结束 使用
表格（ 1 ）。选择
表格（ 1 ）。单元格。选择
Selection.Copy
工作表（表格） .Count）。激活
ActiveSheet.Cells。选择
Selection.PasteSpecial粘贴：= xlPasteFormats，操作：= xlNone，SkipBlanks：= False， Transpose：= False
Application.CutCopyMode = False
Next i
conn.Close
Set conn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
结束 Sub

我们无法帮助您，因为错误取决于工作表的包含。

。范围（  A2）。CopyFromRecordset conn.Execute（Sql）

东西去了你的代码有问题，但你不明白出了什么问题或原因。
使用调试器查看你的代码在做什么，打开局部变量窗口检查它们的值，你可能会发现 Sql 不包含它应该包含的内容。

-----

有一个工具可以让你要查看代码正在执行的操作，其名称为调试程序。它也是一个很好的学习工具，因为它向你展示了现实，你可以看到哪种期望与现实相符。

当你不明白你的代码在做什么或为什么它做它做的时候，答案就是答案是调试器。

使用调试器查看代码正在执行的操作。只需设置断点并查看代码执行情况，调试器允许您逐行执行第1行并在执行时检查变量。



调试器 - 维基百科，免费的百科全书 [ ^ ]

在Excel中调试VBA - 简易Excel宏 [ ^ ]

MS Excel 2013：VBA调试简介 [ ^ ]

如何调试Excel VBA - YouTube [ ^ ]

调试器在这里向您展示您的代码正在做什么，您的任务是与它应该做什么进行比较。

调试器中没有魔法，它没有找到错误，它只是帮助你至。当代码没有达到预期效果时，你就接近了一个错误。



PS：我使用了第二个解决方案来保持清晰，因为两者都不相关。

问题在于您尝试使用该行代码执行的Sql字符串。因为我们看不到那个字符串......



错误是说你试图传递一种对你来说错误的值说得好。就像传入SQL期望数值的字符串一样，或者相反。

I am trying to split an excel spreadsheet with different people's information into different spreadsheets with a single person's information. I got some VBA code from the website but ran into error when I tried to run the code. The error code is "Data type mismatch in criteria expression" And the code with problem is the line ".Range("A2").CopyFromRecordset conn.Execute(Sql) "

Could anyone help me with this? Thank you so much!

What I have tried:

Sub CFGZB()
    Dim myRange As Variant
    Dim myArray
    Dim titleRange As Range
    Dim title As String
    Dim columnNum As Integer
    myRange = Application.InputBox(prompt:="choose title row", Type:=8)
    myArray = WorksheetFunction.Transpose(myRange)
    Set titleRange = Application.InputBox(prompt:="choose the column", Type:=8)
    title = titleRange.Value
    columnNum = titleRange.Column
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i&, Myr&, Arr, num&
    Dim d, k
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "Information" Then
            Sheets(i).Delete
        End If
    Next i
    Set d = CreateObject("Scripting.Dictionary")
    Myr = Worksheets("Information").UsedRange.Rows.Count
    Arr = Worksheets("Information").Range(Cells(2, columnNum), Cells(Myr, columnNum))
    For i = 1 To UBound(Arr)
        d(Arr(i, 1)) = ""
    Next
    k = d.keys
    For i = 0 To UBound(k)
        Set conn = CreateObject("adodb.connection")
        conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
        Sql = "select * from [Information$] where " & title & " = '" & k(i) & "'"
        Worksheets.Add after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = k(i)
            For num = 1 To UBound(myArray)
                .Cells(1, num) = myArray(num, 1)
            Next num
         'it seems that this row has error
            .Range("A2").CopyFromRecordset conn.Execute(Sql)  
     
        End With
        Sheets(1).Select
        Sheets(1).Cells.Select
        Selection.Copy
        Worksheets(Sheets.Count).Activate
        ActiveSheet.Cells.Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    conn.Close
    Set conn = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

解决方案

where " & title & " = '" & k(i) & "'" Worksheets.Add after:=Sheets(Sheets.Count) With ActiveSheet .Name = k(i) For num = 1 To UBound(myArray) .Cells(1, num) = myArray(num, 1) Next num 'it seems that this row has error .Range("A2").CopyFromRecordset conn.Execute(Sql) End With Sheets(1).Select Sheets(1).Cells.Select Selection.Copy Worksheets(Sheets.Count).Activate ActiveSheet.Cells.Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Next i conn.Close Set conn = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

We can't help you much as the error depend on the contain of the sheet.

.Range("A2").CopyFromRecordset conn.Execute(Sql)

Something go wrong in your code, but you don't understand what go wrong or why.
Use the debugger to see what your code is doing, Open the local variable window to inspect their values, you will probably discover that Sql do not contain what it should.
-----
There is a tool that allow you to see what your code is doing, its name is debugger. It is also a great learning tool because it show you reality and you can see which expectation match reality.
When you don't understand what your code is doing or why it does what it does, the answer is debugger.
Use the debugger to see what your code is doing. Just set a breakpoint and see your code performing, the debugger allow you to execute lines 1 by 1 and to inspect variables as it execute.

Debugger - Wikipedia, the free encyclopedia[^]
Debugging in Excel VBA - EASY Excel Macros[^]
MS Excel 2013: VBA Debugging Introduction[^]
How to debug Excel VBA - YouTube[^]
The debugger is here to show you what your code is doing and your task is to compare with what it should do.
There is no magic in the debugger, it don't find bugs, it just help you to. When the code don't do what is expected, you are close to a bug.

PS: I used a second solution to keep things clear as both are not related.

The problem is in the Sql string you're trying to execute with that line of code. Since we can't see that string...

The error is saying that you're trying to pass in a type of value that is wrong for the place you're putting it. Like passing in a string where the SQL is expecting a numeric value, or the other way around.

这篇关于尝试根据列将电子表格拆分为多个时遇到错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！