循环浏览另一个工作簿中的单元格以复制特定值

时间:2018-07-05 16:39:48

标签: excel vba excel-vba

我已经为此奋斗了两天,对其他尝试不知所措。我的目标是提示保存工作簿的位置,该电子表格是从外部来源获得的,名称/位置可能有所不同。打开工作簿后,切换到第二张工作表并开始搜索要复制到宏用完的工作簿中的值。

如果我在最后一行的计算和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列开头和结尾的图像,其中的标识符已删除 enter image description here Beginning

1 个答案:

答案 0 :(得分:1)

使用Sheets(2).Activate代替wkbSource.Sheets(2).Activate。单元格和您正在使用的任何其他类型的范围也是如此。

当您具有多个工作簿交互时,尽可能明确地将其作为目标工作簿尤其重要。

要查找最后一行,请使用此行:

last = wkbSource.Sheets(2).Cells(wkbSource.Sheets(2).Cells.Rows.Count, 1).End(xlUp).Row

编辑:此问题是由隐藏的工作表引起的-在这种情况下,最好使用工作表名称。