Question

初步问题

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

下拉选择：

1A：1C = Company1 Company2 Company3

2A：2C = Version2 Version1 Version1

只有第一个（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）。

谢谢。

后续

@ Dirk Reichel： @全部：

我试图稍微扩展Dirk的想法（见下文），并且每次将特定范围复制/粘贴到＆＃时，我尝试按顺序打开5个（或更少）工作簿39; MAIN2＆＃39;主要表＆＃39;工作簿。

除非我打开的工作簿少于正在检查的下拉值的数量（我目前使用的是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

我使用了3个（现在）5个下拉菜单，目前只有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

如果您的Cells没有任何＆＃34;工作簿＆＃34;和＆＃34;工作表＆＃34;他们将使用活动的那个（在打开第一个工作簿之后，所有Cells将引用它而不是原始来源）

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

1 个答案: