Ячейки: поиск и обращение к другой книге - PullRequest
0 голосов
/ 27 мая 2020

У меня есть две книги. Мне нужно взять строку из WB1 (я перебираю столбец C в WB1, не каждая ячейка содержит строку, но когда ячейка содержит строку, это та, которую я хочу скопировать), найдите ее в WB2 и замените с другой строкой из WB1 (в той же строке, но в столбце A). Вот что у меня есть на данный момент:

' Checks if a given File is already open
Public Function FileInUse(sFileName) As Boolean
    On Error Resume Next
    Open sFileName For Binary Access Read Lock Read As #1
    Close #1
    FileInUse = IIf(Err.Number > 0, True, False)
    On Error GoTo 0
End Function

Sub copyPaste()

Dim destWB As Workbook
Dim destSH As Worksheet
Dim fileName As String
Dim curCell As Range
Dim oldName As Range
Dim result As Range

' turn off screen refresh, recalculate formula to speed up sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' For i = 2 To Rows.Count
For i = 2 To 5
    fileName = "C:\Users...\" & Workbooks("Ressources calculation.xlsm").Worksheets("Tests costs").Cells(i, 2)

    If Not FileInUse(fileName) Then
        Set destWB = Workbooks.Open(fileName)
        Set destSH = destWB.Sheets("Qualification Matrix")
        destSH.Activate
    End If

    Set curCell = Workbooks("Ressources calculation.xlsm").Sheets("Tests costs").Cells(i, 3)
    Set oldName = Workbooks("Ressources calculation.xlsm").Sheets("Tests costs").Cells(i, 1)
    If Not IsEmpty(curCell) Then
        curCell.Copy
        Set result = destWB.Sheets("Qualification Matrix").Cells.Find(What:=oldName.Text, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True)

        If Not result Is Nothing Then
            result.PasteSpecial
        End If
    End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Я добавил MsgBox в предложение «If Not result», которое никогда не срабатывает, поэтому я предполагаю, что он не находит ячейку. Кажется, что строки, которые мне нужно использовать (в curCell и oldName), хорошо извлекаются (проверено также с помощью MsgBox). Ячейки, в которых он должен искать и заменять, являются объединенными ячейками, если это имеет значение. Я также пробовал разные значения для Cells.Find (оставив все необязательные параметры, попробовал все возможности для lookIn и lookat, MatchByte, вместо этого попробовал oldName.Value).

Я впервые делаю что-то с Макросы Excel / VBA, последние несколько часов были потрачены на множество проб и ошибок без каких-либо результатов. Так что я уверен, что то, что у меня есть, далеко от оптимального, но я надеюсь, что кто-то может мне с этим помочь.

Edit: Я немного сузил его. Теперь я активирую dest SH прямо перед Cells.Find и пробовал просто использовать жестко запрограммированный пример String в качестве параметра, который работает. Итак, я думаю, проблема не в инструкции find, а в том, как я пытаюсь извлечь информацию, которую ищу, с помощью find.

Edit2: В соответствии с просьбой, вот краткий пример пошагового руководства:

У меня есть книга под названием «Ressources Расчет.xlsm» с тремя столбцами: текущее имя, имя файла, новое имя. Строка 4 выглядит так:

Misspelledd    [File name].xlsx    Misspelled

Не все ячейки в столбце C заполнены. Я пытаюсь сделать следующее: перебрать каждую ячейку в столбце C, если он не пустой, скопируйте строку, которая находится в той же строке, но в столбце A, найдите ее в файле, который отмечен в столбце B и замените его правильным именем, указанным в столбце C.

Вот изображение ячейки в целевой книге, которую нужно найти и заменить текст, как описано выше. Это объединенная ячейка, занимающая 2-5 ряды. enter image description here

Редактировать 3: наконец-то я выяснил, в чем проблема. В конце некоторых ячеек были «невидимые» разрывы строк (не совсем невидимые, но их нелегко увидеть, так как после них нет символов). Если это не так, код работает.

1 Ответ

0 голосов
/ 27 мая 2020

Попробуйте что-то вроде этого (добавлен файл debug.print для устранения неполадок)

Sub copyPaste()

    Dim destWB As Workbook
    Dim destSH As Worksheet
    Dim fileName As String
    Dim curName, oldName
    Dim result As Range
    Dim wbRes As Workbook, wsTests As Worksheet

    Set wbRes = Workbooks("Ressources calculation.xlsm") 'ThisWorkbook ?
    Set wsTests = wbRes.Worksheets("Tests costs")

    For i = 2 To 5

        fileName = "C:\Users...\" & wsTests.Cells(i, 2)

        If Not FileInUse(fileName) Then
            Set destWB = Workbooks.Open(fileName)
            Set destSH = destWB.Sheets("Qualification Matrix")

            curName = Trim(wsTests.Cells(i, 3).Value) '<< always worth adding Trim()...
            oldName = Trim(wsTests.Cells(i, 1).Value)
            If Len(curName) > 0 Then
                Debug.Print "Looking for: '" & oldName & _
                      "' on sheet '" & destSH.Name & "' in " & _
                      destWB.FullName 

                Set result = destSH.UsedRange.Find(What:=oldName, _
                                                LookIn:=xlValues, _
                                                LookAt:=xlWhole)
                If Not result Is Nothing Then
                    Debug.Print "...found"
                    result.Value = curName
                Else
                    Debug.Print "... not found"
                End If
            End If
        End If      'file not in use

    Next i

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...