我已经为此奋斗了两天,对其他尝试不知所措。我的目标是提示保存工作簿的位置,该电子表格是从外部来源获得的,名称/位置可能有所不同。打开工作簿后,切换到第二张工作表并开始搜索要复制到宏用完的工作簿中的值。
如果我在最后一行的计算和For循环中设置一个断点,那么我拥有的代码将非常有用。如果没有这两个断点,则在运行其余代码之前,工作簿中的任何信息都不会加载。
Public Sub Clm2Count()
Dim i, j, k, last As Long
Dim wkbSource, wkbCrnt As Workbook
Dim str As Variant
Dim strArray()
strArray() = Array("THIS", "IS", "MY", "ARRAY")
Set wkbCrnt = ThisWorkbook
k = 1
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Application.ScreenUpdating = False
Set wkbSource = Workbooks.Open(.SelectedItems(1))
Application.ScreenUpdating = True
End If
End With
Sheets(2).Activate
Cells(5,1).Select 'Trying to activate a cell before calculating last, didn't work
last = wkbSource.Sheets(2).Cells(wkbSource.Sheets(2).Cells.Rows.Count, 1).End(xlUp).Row
For i = 51 To last
If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Value, "TEST") > 0 Then
For Each str In strArray
If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, str, vbTextCompare) > 0 Then
If InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, "A", vbTextCompare) > 0 Or InStr(1, Cells(i, 2).Text, "B", vbTextCompare) > 0 Then
If str = "MY" Then 'Specific value from the array
wkbSource.Sheets(2).Cells(i, 3).Copy
wkbCrnt.Sheets(1).Cells(k, 1).PasteSpecial
wkbCrnt.Sheets(1).Cells(k, 2).Value = "QC"
wkbCrnt.Sheets(1).Cells(k, 3).Value = i & ", " & str
k = k + 1
Exit For
End If
ElseIf InStr(1, wkbSource.Sheets(2).Cells(i, 2).Text, "C", vbTextCompare) > 0 Then
wkbSource.Sheets(2).Cells(i, 3).Copy
wkbCrnt.Sheets(1).Cells(k, 1).PasteSpecial
wkbCrnt.Sheets(1).Cells(k, 2).Value = "QC"
wkbCrnt.Sheets(1).Cells(k, 3).Value = i & ", " & str
k = k + 1
Exit For
Else
Exit For
End If
End If
Next str
wkbSource.Activate
End If
Next i
End Sub
对我可能忽略的东西有什么想法吗?
编辑: 这是A列开头和结尾的图像,其中的标识符已删除 Beginning
答案 0 :(得分:1)
使用Sheets(2).Activate
代替wkbSource.Sheets(2).Activate
。单元格和您正在使用的任何其他类型的范围也是如此。
当您具有多个工作簿交互时,尽可能明确地将其作为目标工作簿尤其重要。
要查找最后一行,请使用此行:
last = wkbSource.Sheets(2).Cells(wkbSource.Sheets(2).Cells.Rows.Count, 1).End(xlUp).Row
编辑:此问题是由隐藏的工作表引起的-在这种情况下,最好使用工作表名称。