VBA-EXCEL 用变量定义范围

Posted 2023-04-19

【中文标题】VBA-EXCEL 用变量定义范围

【英文标题】：VBA-EXCEL Defining Ranges with variables

【发布时间】：2017-06-09 15:08:13

【问题描述】：

问题：我无法使用变量 (i) 和特定单元格行 (cell.Row) 定义范围。

当前代码：

Sub TaskSearch()
'Dim wb As Workbook
Dim oSht As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim aCell As Range


ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents

'Set wb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set oSht = Sheets("TaskMaster")
lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = Sheets("Interface").Range("F5")

Set aCell = oSht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

  Sheets("Interface").Range("D19").Value = Sheets("TaskMaster").Range("C" & aCell.Row).Value
  Sheets("Interface").Range("D20").Value = Sheets("TaskMaster").Range("D" & aCell.Row).Value
  Sheets("Interface").Range("D21").Value = Sheets("TaskMaster").Range("E" & aCell.Row).Value
  Sheets("Interface").Range("D22").Value = Sheets("TaskMaster").Range("F" & aCell.Row).Value
  Sheets("Interface").Range("D23").Value = Sheets("TaskMaster").Range("G" & aCell.Row).Value
  Sheets("Interface").Range("D24").Value = Sheets("TaskMaster").Range("H" & aCell.Row).Value
  Sheets("Interface").Range("D25").Value = Sheets("TaskMaster").Range("I" & aCell.Row).Value
  Sheets("Interface").Range("D26").Value = Sheets("TaskMaster").Range("J" & aCell.Row).Value
  Sheets("Interface").Range("D27").Value = Sheets("TaskMaster").Range("K" & aCell.Row).Value
  Sheets("Interface").Range("D28").Value = Sheets("TaskMaster").Range("L" & aCell.Row).Value
  Sheets("Interface").Range("D29").Value = Sheets("TaskMaster").Range("M" & aCell.Row).Value
  Sheets("Interface").Range("D30").Value = Sheets("TaskMaster").Range("N" & aCell.Row).Value
  Sheets("Interface").Range("D31").Value = Sheets("TaskMaster").Range("O" & aCell.Row).Value
  Sheets("Interface").Range("D32").Value = Sheets("TaskMaster").Range("P" & aCell.Row).Value
  Sheets("Interface").Range("D33").Value = Sheets("TaskMaster").Range("Q" & aCell.Row).Value

Exit Sub

结束子

目标：我正在尝试使这段代码更加健壮。部分原因是我能够跳过空白。尝试调整单元格时，这是一场噩梦。

我尝试了两种不同的方法来实现这一点：

方法一：

wb.Sheets("Interface").Range("D19:D33").Copy
  wb.Sheets("TaskMaster").Range("C" & aCell.Row & ":Q" & aCell.Row).PastSpecial Paste:=xlPasteValues, SkipBlanks:=True

失败：运行时错误 438：对象不支持此属性或方法。

方法B：

   For j = 3 To 16
    If Not IsEmpty(j, aCell.Row) Then
        For i = 19 To 33

            iWb.oSht.Range(j, aCell.Row).Value = _
           iWb.iSht.Range(4, i).Value

        Next i
    End If
Next j

Exit Sub

失败：（我无法让这个旧版本再次编译）我认为错误是由定义范围的问题引起的。

总而言之，我试图找到使用.find 将信息从一个工作表传输到另一个工作表的最快方法。我也在尝试在传输时不复制空白单元格。

我目前认为这种方法最适合我的应用。

Sub TSearch()
Dim dWb As Workbook, Wb As Workbook
Dim oSht As Worksheet, Sht As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim strSearch As String
Dim aCell As Variant
Dim cell As Variant
'On Error GoTo Err

ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents

'Set dWb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set Wb = ThisWorkbook
Set Sht = Sheets("TaskMaster") ' Reference Worksheet
Set oSht = Sheets("Interface") ' User Interface Worksheet

lastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Obtain Last row of reference Worksheet
strSearch = oSht.Range("F5") 'Obtain User Selected Search Criteria

Set aCell = Sht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

For j = 3 To 16 'Columns from Reference Worksheet to be transfered
    If Not IsEmpty(Wb.Sht.Cells(aCell.Row, j)) Then ' Verify If cell has value before transfering
        For i = 19 To 33 ' Rows of User Interface where values are to be transfered
            Wb.Sht.Cells(aCell.Row, j).Value = _
            Wb.oSht.Cells(i, 4).Value

        Next i
    End If
  Next j
 Exit Sub

 'Err: 'MsgBox " Generic Task not found" & vbCrLf

 End Sub

IEmpty 函数仍然导致错误 438：对象不支持此属性方法。如果我删除 IsEmpty 然后 'Wb.Sht.Cells(aCell.Row, j).Value = Wb.oSht.Cells(i, 4).Value' 给了我同样的错误。

【问题讨论】：

aCell的值是多少？

抱歉，工作簿定义不明确，因为我一直在努力保留以后将信息传输到数据库的能力。然而，它们已被证实是正确的。

我不建议复制和粘贴，但您的方法 A 有可能导致错误的错字。你使用了PastSpecial 而不是PasteSpecial

我的问题仍然存在。如果您的.Find 返回多个单元格，我不相信aCell.Row 会起作用，如果确实如此，它不会在Range("A" & .... 的上下文中起作用）

使用您的方法 B，您将遵循 Cells() 的参数，而不是 Range()。请改用Cells()，它按以下顺序接受参数：Cells([row_index], [column_index])。所以像iWb.oSht.Cells(aCell.Row, j).Value = iWb.iSht.Range(i, 4).Value

【参考方案1】：

由于IsEmpty 需要检查单个单元格或变量，您的循环将无法工作，但您给了它两个数字。下面应该可以工作，但有些东西不合格，所以你可能仍然会遇到问题。此外，Range() 期望提供两个范围或范围字符串。我想你在寻找Cells()，它接受一行（作为数字）作为第一个参数，一列（作为数字）作为第二个参数。

For j = 3 To 16
    If Not IsEmpty(cells(aCell.Row, j)) Then
        For i = 19 To 33

            iWb.oSht.Cells(aCell.Row, j).Value = _
           iWb.iSht.Cells(4, i).Value

        Next i
    End If
Next j

End Sub

【讨论】：

我已经相应地更新了代码，但是我是否需要像If Not IsEmpty(Wb.Sht.Cells(aCell.Row, j)) Then 那样引用IsEmpty 的工作簿和工作表@ 我是否正确地注意到 ros 是列之后的第一个索引.在这种情况下，我做出了正确的更改。

您没有有来限定工作簿和工作表，但这样做是一种很好的形式。在这种情况下，我当然会。 .Cells() 首先是行，然后是列，这也是正确的。我已经调整了我的例子。

【参考方案2】：

似乎错误是由于尝试定义已定义的内容。

Sub TSearch()
Dim dWb As Workbook, Wb As Workbook
Dim oSht As Worksheet, Sht As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim strSearch As String
Dim aCell As Variant
Dim cell As Variant
'On Error GoTo Err

ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents

'Set dWb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set Wb = ThisWorkbook
Set Sht = Sheets("TaskMaster")                      ' Reference Worksheet
Set oSht = Sheets("Interface")                      ' User Interface Worksheet

lastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Obtain Last row of reference Worksheet
strSearch = oSht.Range("F5")                        'Obtain User Selected Search Criteria

 'Find Row in Reference Worksheet that Matches Search Criteria
Set aCell = Sht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

For j = 3 To 16
    If Not IsEmpty(Cells(aCell.Row, j)) Then
        i = j + 16
            oSht.Cells(i, 4).Value = Cells(aCell.Row, j).Value
    End If
Next j

 Exit Sub

 'Err:
'MsgBox " Generic Task not found" & vbCrLf

 End Sub

感谢 @Jordan 和 @Kyle 帮助解决此问题。