Excel VBA，数组范围问题

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

Excel VBA, array range issue

问题

我有以下代码，基于“Main”工作表中单元格B5中的用户输入，将搜索输入的零件号码在另外两个工作表，“SHORTAGE”和“PPN”中，并返回相应的数据列和行。代码有效，但我需要更改shortageData数组的数据范围，从列B到F，改为从列A到F，再加上列L和N。我已经进行了研究并尝试了一些方法，比如合并范围Union(promptSheet.Range("A1:F" & promptLastRow), promptSheet.Range("L1:L" & promptLastRow), promptSheet.Range("N1:N" & promptLastRow)).Value，以及promptData = promptSheet.Range("A1:F" & promptLastRow & ", L1:L" & promptLastRow & ", N1:N" & promptLastRow).Value，但都不起作用，它会返回A:F的正确值，但对于接下来的两列L和N，它返回所有的#REF!值。我尝试使用chatGPT也无法解决。是否有人能够协助解决这个问题？非连续范围有关吗？

  1. Sub Button2_Click()
  2.     Dim partNum As String
  3.     Dim mainSheet As Worksheet
  4.     Dim shortageSheet As Worksheet
  5.     Dim ppnSheet As Worksheet
  6.     Dim mainLastRow As Long
  7.     Dim shortageLastRow As Long
  8.     Dim ppnLastRow As Long
  9.     Dim shortageData As Variant
  10.     Dim ppnData As Variant
  11.     Dim i As Long
  12.     Dim recordFound As Boolean
  13.     Application.ScreenUpdating = False
  14.     Set mainSheet = ThisWorkbook.Sheets("Main")
  15.     Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
  16.     Set ppnSheet = ThisWorkbook.Sheets("PPN")
  17.     partNum = mainSheet.Range("B5").Value
  18.     If partNum = "" Then
  19.         MsgBox "Please enter a part number.", vbExclamation
  20.         Exit Sub
  21.     End If
  22.     mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
  23.     mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
  24.     shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
  25.     shortageData = shortageSheet.Range("A1:F" & shortageLastRow & ", L1:L" & shortageLastRow & ", N1:N" & shortageLastRow).Value
  26.     For i = 1 To shortageLastRow
  27.         If shortageData(i, 1) = partNum Then
  28.             mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
  29.             mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
  30.                 Application.Index(shortageData, i, Array(1, 2, 3, 4, 5))
  31.             recordFound = True
  32.         End If
  33.     Next i
  34.     If Not recordFound Then
  35.         MsgBox "No records found in SHORTAGE"
  36.     End If
  37.     recordFound = False
  38.     ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
  39.     ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
  40.     For i = 1 To ppnLastRow
  41.         If ppnData(i, 1) = partNum Then
  42.             mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
  43.             mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
  44.                 Application.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  45.             recordFound = True
  46.         End If
  47.     Next i
  48.     If Not recordFound Then
  49.         MsgBox "No records found in PPN"
  50.     End If
  51.     Application.CutCopyMode = False
  52.     Application.ScreenUpdating = True
  53.     MsgBox "Search complete!", vbInformation
  54. End Sub

请注意，我已经修改了代码，以便在加载shortageData和ppnData时包括了列L和N。希望这对你有所帮助。

英文:

I have the below code that based on user input in cell B5 in "Main" worksheet will search the input part number in another two worksheets, "SHORTAGE" and "PPN", and return the corresponding columns and rows of data, the code works but I need to change the data range for shortageData array from columns B to F, to A to F, plus L, and N. I have researched and tried a few methods, like union range Union(promptSheet.Range("A1:F" & promptLastRow), promptSheet.Range("L1:L" & promptLastRow), promptSheet.Range("N1:N" & promptLastRow)).Value, and promptData = promptSheet.Range("A1:F" & promptLastRow & ", L1:L" & promptLastRow & ", N1:N" & promptLastRow).Value, but none works, it returns the correct values for A:F, but for the next two columns L, and N, it returns all #REF! values. Tried using chatGPT and too wasn't able to get a fix. Is anyone able to assist in this? Any help is much appreciated! Does it have to do with non-contiguous range?

  1. Sub Button2_Click()
  2. Dim partNum As String
  3. Dim mainSheet As Worksheet
  4. Dim shortageSheet As Worksheet
  5. Dim ppnSheet As Worksheet
  6. Dim mainLastRow As Long
  7. Dim shortageLastRow As Long
  8. Dim ppnLastRow As Long
  9. Dim shortageData As Variant
  10. Dim ppnData As Variant
  11. Dim i As Long
  12. Dim recordFound As Boolean
  13. Application.ScreenUpdating = False
  14. Set mainSheet = ThisWorkbook.Sheets("Main")
  15. Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
  16. Set ppnSheet = ThisWorkbook.Sheets("PPN")
  17. partNum = mainSheet.Range("B5").Value
  18. If partNum = "" Then
  19.     MsgBox "Please enter a part number.", vbExclamation
  20.     Exit Sub
  21. End If
  22. mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
  23. mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
  24. shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
  25. shortageData = shortageSheet.Range("B1:F" & shortageLastRow).Value
  26. For i = 1 To shortageLastRow
  27.     If shortageData(i, 1) = partNum Then
  28.         mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
  29.         mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
  30.             Application.Index(shortageData, i, Array(1, 2, 3, 4, 5))
  31.         recordFound = True
  32.     End If
  33. Next i
  34. If Not recordFound Then
  35.     MsgBox "No records found in SHORTAGE"
  36. End If
  37. recordFound = False
  38. ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
  39. ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
  40. For i = 1 To ppnLastRow
  41.     If ppnData(i, 1) = partNum Then
  42.         mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
  43.         mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
  44.             Application.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  45.         recordFound = True
  46.     End If
  47. Next i
  48. If Not recordFound Then
  49.     MsgBox "No records found in PPN"
  50. End If
  51. Application.CutCopyMode = False
  52. Application.ScreenUpdating = True
  53. MsgBox "Search complete!", vbInformation
  54. End Sub

答案1

得分: 1

这个函数非常长且复杂，所以我会首先进行重构。首先，你应该提取两个类似这样的函数：

  1. Option Explicit
  3. Public Sub Button2_Click()
  4.     Application.ScreenUpdating = False
  5.     
  6.     Dim mainSheet As Worksheet: Set mainSheet = ThisWorkbook.Sheets("Main")
  7.     mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
  8.     mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
  9.     Dim partNum As String: partNum = mainSheet.Range("B5").Value
  10.     If partNum = "" Then
  11.         MsgBox "Please enter a part number.", vbExclamation
  12.         Exit Sub
  13.     End If
  14.     
  15.     SearchShortage mainSheet, partNum
  16.     
  17.     SearchPpn mainSheet, partNum
  18.     
  19.     Application.CutCopyMode = False
  20.     Application.ScreenUpdating = True
  21.     MsgBox "Search complete!", vbInformation
  22. End Sub
  24. Public Sub SearchShortage(mainSheet As Worksheet, partNum As String)
  25.     Dim shortageSheet As Worksheet: Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
  26.     Dim shortageLastRow As Long: shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
  27.     Dim shortageData As Variant: shortageData = shortageSheet.Range("B1:F" & shortageLastRow).Value
  28.     Dim recordFound As Boolean: recordFound = False
  29.     Dim i As Long: For i = 1 To shortageLastRow
  30.         If shortageData(i, 1).Value = partNum Then
  31.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
  32.             mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
  33.                 WorksheetFunction.Index(shortageData, i, Array(1, 2, 3, 4, 5))
  34.             recordFound = True
  35.         End If
  36.     Next i
  37.     If Not recordFound Then
  38.         MsgBox "No records found in SHORTAGE"
  39.     End If
  40. End Sub
  42. Public Sub SearchPpn(mainSheet As Worksheet, partNum As String)
  43.     Dim ppnSheet As Worksheet: Set ppnSheet = ThisWorkbook.Sheets("PPN")
  44.     Dim ppnLastRow As Long: ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
  45.     Dim ppnData As Variant: ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
  46.     Dim recordFound As Boolean: recordFound = False
  47.     Dim i As Long: For i = 1 To ppnLastRow
  48.         If ppnData(i, 1).Value = partNum Then
  49.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
  50.             mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
  51.                 WorksheetFunction.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  52.             recordFound = True
  53.         End If
  54.     Next i
  55.     If Not recordFound Then
  56.         MsgBox "No records found in PPN"
  57.     End If
  58. End Sub

然后，我会继续查找SearchShortage和SearchPpn之间的相似之处，并创建一个更抽象的函数，该函数使用不同的参数进行调用。但由于我没有你的工作簿，无法测试任何修改。我还看到一些可能会导致错误的不一致之处（例如，mainSheet的B:I范围（8列）被用5个值覆盖，而其I:O范围（7列）被用8个值覆盖）。因此，我将跳过这部分。

接下来，我想要更准确地了解你的问题。根据你的描述，我认为你想添加一个函数，我们称之为SearchPrompt，它有类似的任务，如下所示：

  1. Public Sub Searchprompt(mainSheet As Worksheet, partNum As String)
  2.     Dim promptSheet As Worksheet: Set promptSheet = ThisWorkbook.Sheets("PROMPT")
  3.     Dim promptLastRow As Long: promptLastRow = promptSheet.Cells(promptSheet.Rows.Count, "B").End(xlUp).Row
  4.     Dim promptData As Variant: promptData = Union(promptSheet.Range("A1:F" & promptLastRow), promptSheet.Range("L1:L" & promptLastRow), promptSheet.Range("N1:N" & promptLastRow)).Value,
  5.     Dim recordFound As Boolean: recordFound = False
  6.     Dim i As Long: For i = 1 To promptLastRow
  7.         If promptData(i, 1).Value = partNum Then
  8.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "S").End(xlUp).Row + 1
  9.             mainSheet.Range("S" & mainLastRow & ":Z" & mainLastRow).Value = _
  10.                 WorksheetFunction.Index(promptData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  11.             recordFound = True
  12.         End If
  13.     Next i
  14.     If Not recordFound Then
  15.         MsgBox "No records found in prompt"
  16.     End If
  17. End Sub

问题是前面六个单元格（在上面的示例中，S:X，我猜测是B:F用于Shortage，然后是2个空列，I:P用于PPN，然后是2个空列，最后是S:Z用于prompt）填充了正确的值，而最后两个（Y:Z）填充了#REF!。

你已经正确注意到这可能是由于非连续范围引起的。我认为这可能是原因，Union创建一个Range对象，其.Areas属性中有多个“子范围”，如果你引用其.Value，那么它会被解释为.Areas(1).Value，其余部分（例如.Areas(2)）会被忽略。

现在有两个解决方案：

（1）在你的代码中遍历这些.Areas - 这比另一个解决方案稍微困难一些，我对你的工作表了解不够，无

英文:

This function is quite long and complicated, so I would start with refactoring it. First of all, you should extract two functions like this:

  1. Option Explicit
  3. Public Sub Button2_Click()
  4.     Application.ScreenUpdating = False
  5.     
  6.     Dim mainSheet As Worksheet: Set mainSheet = ThisWorkbook.Sheets("Main")
  7.     mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
  8.     mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
  9.     Dim partNum As String: partNum = mainSheet.Range("B5").Value
  10.     If partNum = "" Then
  11.         MsgBox "Please enter a part number.", vbExclamation
  12.         Exit Sub
  13.     End If
  14.     
  15.     SearchShortage mainSheet, partNum
  16.     
  17.     SearchPpn mainSheet, partNum
  18.     
  19.     Application.CutCopyMode = False
  20.     Application.ScreenUpdating = True
  21.     MsgBox "Search complete!", vbInformation
  22. End Sub
  24. Public Sub SearchShortage(mainSheet As Worksheet, partNum As String)
  25.     Dim shortageSheet As Worksheet: Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
  26.     Dim shortageLastRow As Long: shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
  27.     Dim shortageData As Variant: shortageData = shortageSheet.Range("B1:F" & shortageLastRow).Value
  28.     Dim recordFound As Boolean: recordFound = False
  29.     Dim i As Long: For i = 1 To shortageLastRow
  30.         If shortageData(i, 1).Value = partNum Then
  31.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
  32.             mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
  33.                 WorksheetFunction.Index(shortageData, i, Array(1, 2, 3, 4, 5))
  34.             recordFound = True
  35.         End If
  36.     Next i
  37.     If Not recordFound Then
  38.         MsgBox "No records found in SHORTAGE"
  39.     End If
  40. End Sub
  42. Public Sub SearchPpn(mainSheet As Worksheet, partNum As String)
  43.     Dim ppnSheet As Worksheet: Set ppnSheet = ThisWorkbook.Sheets("PPN")
  44.     Dim ppnLastRow As Long: ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
  45.     Dim ppnData As Variant: ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
  46.     Dim recordFound As Boolean: recordFound = False
  47.     Dim i As Long: For i = 1 To ppnLastRow
  48.         If ppnData(i, 1).Value = partNum Then
  49.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
  50.             mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
  51.                 WorksheetFunction.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  52.             recordFound = True
  53.         End If
  54.     Next i
  55.     If Not recordFound Then
  56.         MsgBox "No records found in PPN"
  57.     End If
  58. End Sub

Then, I would go on with finding similarities between SearchShortage and SearchPpn and creating a more abstract function, which is called with different parameters. However, since I do not have your workbook, I cannot test any modification. And I see some inconsistencies that may cause error (e.g. mainSheet's B:I range (8 columns) is overwritten with 5 values, while its I:O range (7 columns) is overwritten with 8 values). So I 'll skip this part.

Next, I'd like to understand your problem exactly. Based on what you wrote, I think you would like to add a function, let's call it SearchPrompt that has a similar task, like this:

  1. Public Sub Searchprompt(mainSheet As Worksheet, partNum As String)
  2.     Dim promptSheet As Worksheet: Set promptSheet = ThisWorkbook.Sheets("PROMPT")
  3.     Dim promptLastRow As Long: promptLastRow = promptSheet.Cells(promptSheet.Rows.Count, "B").End(xlUp).Row
  4.     Dim promptData As Variant: promptData = Union(promptSheet.Range("A1:F" & promptLastRow), promptSheet.Range("L1:L" & promptLastRow), promptSheet.Range("N1:N" & promptLastRow)).Value,
  5.     Dim recordFound As Boolean: recordFound = False
  6.     Dim i As Long: For i = 1 To promptLastRow
  7.         If promptData(i, 1).Value = partNum Then
  8.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "S").End(xlUp).Row + 1
  9.             mainSheet.Range("S" & mainLastRow & ":Z" & mainLastRow).Value = _
  10.                 WorksheetFunction.Index(promptData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
  11.             recordFound = True
  12.         End If
  13.     Next i
  14.     If Not recordFound Then
  15.         MsgBox "No records found in prompt"
  16.     End If
  17. End Sub

And the problem is that the first six cells (in the above example, S:X as I guessed, that B:F is for Shortage, then 2 empty columns, I:P for PPN, then 2 empty columns, and finally S:Z for prompt) are filled with the correct values, while the last two (Y:Z) are filled with #REF!.

You have already correctly noted that this may be caused by the non-contiguous range. I suppose that is the case, Union creates a Range object that has multiple "subranges" in its .Areas property, and if you refer to its .Value, then it is interpreted as .Areas(1).Value, and the rest (e.g. .Areas(2) is ignored).

Now there are two solutions:

(1) Iterate over these .Areas in your code - this is a little bit more difficult than the other solution, and I do not know enough about your worksheet to make a good guess about it.

(2) Simply use a contiguous range. You can search in the range A:N, and then later (when presenting the results) omit the cells that you don't need. You can do that by customizing the numbers in the array supplied as the third parameter of Application.Index (more correctly, WorksheetFunction.Index), like this:

  1. Public Sub Searchprompt(mainSheet As Worksheet, partNum As String)
  2.     Dim promptSheet As Worksheet: Set promptSheet = ThisWorkbook.Sheets("PROMPT")
  3.     Dim promptLastRow As Long: promptLastRow = promptSheet.Cells(promptSheet.Rows.Count, "B").End(xlUp).Row
  4.     Dim promptData As Variant: promptData = promptSheet.Range("A1:N" & promptLastRow).Value
  5.     Dim recordFound As Boolean: recordFound = False
  6.     Dim i As Long: For i = 1 To promptLastRow
  7.         If promptData(i, 1).Value = partNum Then
  8.             Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "S").End(xlUp).Row + 1
  9.             mainSheet.Range("S" & mainLastRow & ":X" & mainLastRow).Value = _
  10.                 WorksheetFunction.Index(promptData, i, Array(1, 2, 3, 4, 5, 6, 12, 14))
  11.             recordFound = True
  12.         End If
  13.     Next i
  14.     If Not recordFound Then
  15.         MsgBox "No records found in prompt"
  16.     End If
  17. End Sub

Note that WorksheetFunction.Index is called with Array(1, 2, 3, 4, 5, 6, 12, 14): 1 .. 6 refer to A .. F, 12 to L and 14 to N.

huangapple
  • 本文由 发表于 2023年5月28日 16:31:29
  • 转载请务必保留本文链接：https://go.coder-hub.com/76350589.html
  • arrays
  • excel
  • range
  • vba
匿名

发表评论

匿名网友

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

确定