vba - 下拉选择后无法打开匹配的工作簿

Question

初始问题

为什么我无法打开所有(全部三个)匹配的工作簿？

下拉选择:

1A:1C = 公司1 公司2 公司3

2A:2C = 版本2 版本1 版本1

只有第一个(Company1、Version2)会打开...

Sub OpenWorkbooks()

Dim ColumnIndex1 As Integer
Dim ColumnIndex2 As Integer
Dim ColumnIndex3 As Integer
Dim ColumnIndex4 As Integer
Dim ColumnIndex5 As Integer
Dim ColumnIndex6 As Integer

For ColumnIndex1 = 1 To 3
If Cells(1, ColumnIndex1).Value = "Company1" And Cells(2,      
ColumnIndex1).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company1\Version1.xlsx"
End If
Next ColumnIndex1

For ColumnIndex2 = 1 To 3
If Cells(1, ColumnIndex2).Value = "Company1" And Cells(2,
ColumnIndex2).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company1\Version2.xlsx"
End If
Next ColumnIndex2

For ColumnIndex3 = 1 To 3
If Cells(1, ColumnIndex3).Value = "Company2" And Cells(2,
ColumnIndex3).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company2\Version1.xlsx"
End If
Next ColumnIndex3

For ColumnIndex4 = 1 To 3
If Cells(1, ColumnIndex4).Value = "Company2" And Cells(2, 
ColumnIndex4).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company2\Version2.xlsx"
End If
Next ColumnIndex4

For ColumnIndex5 = 1 To 3
If Cells(1, ColumnIndex5).Value = "Company3" And Cells(2, 
ColumnIndex5).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company3\Version1.xlsx"
End If
Next ColumnIndex5

For ColumnIndex6 = 1 To 3
If Cells(1, ColumnIndex6).Value = "Company3" And Cells(2, 
ColumnIndex6).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company3\Version2.xlsx"
End If
Next ColumnIndex6

End Sub

我刚刚开始使用 VBA(和 StackOverflow)。

谢谢。

跟进

@德克·赖切尔:@全部:

我尝试稍微扩展德克的想法(见下文)，并且每次将特定范围复制/粘贴到“main2”工作表时，我尝试按顺序打开 5 个(或更少)工作簿' 工作簿。

除非我打开的工作簿少于正在检查的下拉值的数量，否则它工作正常(我当前使用 5 个下拉集而不是原来的 3 个:请参见页面顶部):

Sub ImportData()

Dim MainWorkbook As Workbook
Dim DataWorkbook As Workbook
Dim i As Long

Set MainWorkbook = ThisWorkbook

With MainWorkbook.ActiveSheet

For i = 2 To 6

If ActiveSheet.Cells(6, i).Value <> "" Then

Set DataWorkbook = Workbooks.Open("D:\ 'some folders' \" & .Cells(6, 
i).Value & "-" & .Cells(10, 2) & "-" & .Cells(7, i).Value & ".xlsx")
DataWorkbook.Sheets("Sheet1").Range("C3:Q3").Copy
MainWorkbook.Sheets("Main2").Range("A" & i).PasteSpecial

On Error Resume Next

End If

Next i

End With

End Sub

我已经使用了(现在)5 个下拉菜单中的 3 个，并且当前仅打开和复制了 1 个工作簿...

Answer 1

您可以尝试像这样更简单的脚本:

Sub OpenWorkbooks()
  Dim i As Long
  With ThisWorkbook.ActiveSheet
    For i = 1 To 3
      Workbooks.Open Filename:="D:\" & .Cells(1, i).Value & "\" & .Cells(2, i).Value & ".xlsx"
    Next i
  End With
End Sub

如果您的单元格没有任何“工作簿”和“工作表”，他们将使用事件的工作簿(打开第一个工作簿后，您的所有单元格)引用它而不是原始来源)