Excel VBA操作范围时出现类型不匹配错误。

huangapple
go评论120阅读模式
英文:

Excel VBA working with ranges gets a Type Mismatch error

问题

我正在编写一个宏，它会循环遍历工作簿中的所有工作表。我需要获取从第11行到第30列开始的数据。每个工作表的最后一行都不同。

我尝试使用SQL和范围来获取每个工作表上所需的数据。获取数据后，我想将其粘贴到“数据”工作表上。在遍历所有工作表后，宏将执行一些其他操作。

我不经常使用SQL，而且我用过的几次数据始终都是从第1行/第1列开始的。这是我第一次尝试获取不是从第1行/第1列开始的数据。

当我运行宏时，我收到类型不匹配错误（在下面的代码中指示）。所有变量都已声明为公共变量。

英文:

I'm working on a macro that is cycling through all of the worksheets in a workbook. I need to grab data that starts on row 11 and goes to column 30. The last row on any given worksheet is different.

I'm trying to use SQL and Ranges to get the data I need on each worksheet. Once I get the data, I want to paste it on the "Data" worksheet. Once I go through all of the worksheets, the macro will do some other things.

I don't use SQL very often and the few times that I have my data has always started on row 1 / column 1. This is the first time I'm trying to grab data that does not start on row 1 / column 1.

When I run the macro, I'm getting a type mismatch error (indicated in the code below). All variables have been declared as public variables.

  1. MyFileName = ""
  2. MyFileName = ActiveWorkbook.Name
  4. WrkShtCnt = 0
  5. WrkShtCnt = Worksheets.Count
  6.     
  7. ws = 1
  8.     
  9. Do Until ws > WrkShtCnt
  10.     
  11.      DoEvents
  12.         
  13.      WrkShtName = ""
  14.      WrkShtName = Trim(Workbooks(MyFileName).Worksheets(ws).Name)
  15.         
  16.      If UCase(WrkShtName) = "NOTES" Or UCase(WrkShtName) = "DATA" Then
  17.           'skip as the macro will NOT be grabbing data from these 2 worksheets
  18.      Else
  19.           vStartDate = ""
  20.           vStartDate = Format(Workbooks(MyFileName).Worksheets(ws).Cells(2, 1), "mm/dd/yyyy")
  21.             
  22.           vEndDate = ""
  23.           vEndDate = Format(Workbooks(MyFileName).Worksheets(ws).Cells(3, 1), "mm/dd/yyyy")
  24.             
  25.           vExtra = ""
  26.           vExtra = UCase(Trim(Workbooks(MyFileName).Worksheets(ws).Cells(4, 1)))
  27.             
  28.           vStr = ""
  29.             
  30.           If Len(vExtra) = 0 Then
  31.                vStr = vStartDate & " - " & vEndDate
  32.           Else
  33.                vStr = vStartDate & " - " & vEndDate & " " & vExtra
  34.           End If
  35.                     
  36.           vLastRow = 0
  37.           vLastRow = Workbooks(MyFileName).Worksheets(ws).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
  38.             
  39.           MySheet = ""
  40.           Set MySheet = Workbooks(MyFileName).Worksheets(ws)
  41.             
  42.           Set MyData = MySheet.Range(Workbooks(MyFileName).Worksheets(ws).Cells(11, 13), Worksheets(ws).Cells(vLastRow, 30))
  43.             
  44.           Dim dBcn As New ADODB.Connection
  45.           Dim dbRS As New ADODB.Recordset
  47.           dBConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyData & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
  48.             
  49.           dBcn.Open dBConn     
  50.             
  51.           vsql = ""
  52.           vsql = "SELECT * FROM MyData"
  54.           dbRS.Open vsql, dBcn   ' type mismatch error occurs on this line of code
  55.             
  56.             If FirstTime = True Then
  57.                Workbooks(MyFileName).Worksheets("Data").Cells(2, 1).CopyFromRecordset dbRS
  58.                FirstTime = False
  59.             Else
  60.                 vLastRow = vLastRow + 1
  61.                 Workbooks(MyFileName).Worksheets("Data").Cells(vLastRow, 1).CopyFromRecordset dbRS
  62.             End If
  63.                        
  64.             Set MyData = Nothing
  65.             dbRS.Close
  66.             dBcn.Close
  67.         
  68.         End If
  69.         
  70.         ws = ws + 1
  71.         
  72.    Loop

Some of the code is what I found while researching and I'm trying to adapt it to my situation.

Thanks in advance for any help or suggestions you provide that will can be past this roadblock. My endusers will thank you as well.....Thanks again.

答案1

得分: 1

以下是代码的部分，已被翻译成中文：

  1. Option Explicit
  3. Sub GetData()
  5.     Dim wb As Workbook, ws As Worksheet, wsData As Worksheet
  6.     Dim rngData As Range, LastRow As Long, r As Long
  7.     
  8.     Dim dbConn  As ADODB.Connection, sConn As String, rs As ADODB.Recordset
  9.     Dim SQL As String
  10.     Set dbConn = New ADODB.Connection
  11.     
  12.     ' 配置
  13.     Set wb = ActiveWorkbook
  14.     Set wsData = wb.Sheets("Data")
  15.     wsData.UsedRange.Offset(1).ClearContents ' 保留标题
  16.     
  17.     ' 连接到工作簿
  18.     sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  19.             "Data Source=" & wb.FullName & _
  20.             ";Extended Properties=""Excel 12.0 Macro;HDR=No;IMEX=1"";"
  21.     'Debug.Print sConn
  22.     dbConn.Open sConn
  23.     
  24.     ' 扫描每个工作表
  25.     For Each ws In wb.Sheets
  26.         If UCase(ws.Name) = "NOTES" Or ws.Name = wsData.Name Then
  27.               ' 跳过，因为宏不会从这两个工作表中提取数据
  28.         Else
  29.                                     
  30.             ' 数据范围
  31.             LastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
  32.             If LastRow < 11 Then
  33.                  MsgBox "最后一行 < 11 = " & LastRow, vbCritical
  34.                  Exit Sub
  35.             Else
  36.                  Set rngData = ws.Range("M11:AD" & LastRow)
  37.             End If
  38.             
  39.             SQL = "SELECT * FROM [" & ws.Name & "$" & rngData.Address(0, 0) & "]"
  40.             'Debug.Print SQL
  41.             
  42.             ' 复制记录
  43.             Set rs = New ADODB.Recordset
  44.             rs.Open SQL, dbConn, adOpenForwardOnly
  45.             With wsData
  46.                If r < 2 Then r = 2
  47.                .Range("A" & r).CopyFromRecordset rs
  48.                r = 1 + .Cells(.Rows.Count, "A").End(xlUp).Row
  49.             End With
  50.             
  51.         End If
  52.     Next
  53.     dbConn.Close
  54.     Set dbConn = Nothing
  55.     MsgBox r - 2 & "条记录已复制到" & wsData.Name, vbInformation
  56. End Sub
英文:

Use the address of the range in the SQL.

  1. Option Explicit
  3. Sub GetData()
  5.     Dim wb As Workbook, ws As Worksheet, wsData As Worksheet
  6.     Dim rngData As Range, LastRow As Long, r As Long
  7.     
  8.     Dim dbConn  As ADODB.Connection, sConn As String, rs As ADODB.Recordset
  9.     Dim SQL As String
  10.     Set dbConn = New ADODB.Connection
  11.     
  12.     &#39; config
  13.     Set wb = ActiveWorkbook
  14.     Set wsData = wb.Sheets(&quot;Data&quot;)
  15.     wsData.UsedRange.Offset(1).ClearContents &#39; leave header
  16.             
  17.     &#39; connect to workbook
  18.     sConn = &quot;Provider=Microsoft.ACE.OLEDB.12.0;&quot; &amp; _
  19.             &quot;Data Source=&quot; &amp; wb.FullName &amp; _
  20.             &quot;;Extended Properties=&quot;&quot;Excel 12.0 Macro;HDR=No;IMEX=1&quot;&quot;;&quot;
  21.     &#39;Debug.Print sConn
  22.     dbConn.Open sConn
  23.    
  24.     &#39; scan each sheets
  25.     For Each ws In wb.Sheets
  26.         If UCase(ws.Name) = &quot;NOTES&quot; Or ws.Name = wsData.Name Then
  27.               &#39;skip as the macro will NOT be grabbing data from these 2 worksheets
  28.         Else
  29.                                     
  30.             &#39; entent of data
  31.             LastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
  32.             If LastRow &lt; 11 Then
  33.                  MsgBox &quot;Last row &lt; 11 = &quot; &amp; LastRow, vbCritical
  34.                  Exit Sub
  35.             Else
  36.                  Set rngData = ws.Range(&quot;M11:AD&quot; &amp; LastRow)
  37.             End If
  38.             
  39.             SQL = &quot;SELECT * FROM [&quot; &amp; ws.Name &amp; &quot;$&quot; &amp; rngData.Address(0, 0) &amp; &quot;]&quot;
  40.             &#39;Debug.Print SQL
  41.             
  42.             &#39; copy records
  43.             Set rs = New ADODB.Recordset
  44.             rs.Open SQL, dbConn, adOpenForwardOnly
  45.             With wsData
  46.                If r &lt; 2 Then r = 2
  47.                .Range(&quot;A&quot; &amp; r).CopyFromRecordset rs
  48.                r = 1 + .Cells(.Rows.Count, &quot;A&quot;).End(xlUp).Row
  49.             End With
  50.             
  51.         End If
  52.     Next
  53.     dbConn.Close
  54.     Set dbConn = Nothing
  55.     MsgBox r - 2 &amp; &quot; records copied to &quot; &amp; wsData.Name, vbInformation
  56. End Sub
  58. </details>

huangapple
  • 本文由 发表于 2023年5月21日 23:53:55
  • 转载请务必保留本文链接：https://go.coder-hub.com/76300742.html
  • excel
  • named-ranges
  • sql
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定