Скрипт не сохраняет данные

[Meta2]

Всем привет!

У меня такая проблема - есть скрипт на VBA для Excel 2003 который должен обработать ~8000 однотипных файлов, извлечь из них данные и запихнуть в результирующую таблицу.

При проверке работоспособности скрипта выяснилась интересная особенность - данные он извлекает, но почему-то на лист они не попадают.

Скрипт долго-долго выдёргивает данные из файла, формируя в конце концов несколько строк, которые записывает нужные в ячейки листа.

Если запускать скрипт под отладчиком и время от времени переключаться окно Excel, то всё будет нормально, ячейки будут заполняться значениями.

Если же остаывить его работать просто так, то ничего происходить не будет.

Если же запустить под отладчиком и ткнуть в окно excel, то можно заметить, как скрипт вставляет данные, а потом они куда-то исчезают...

Помогите победить, пожалуйста!

Код макроса идёт в следующем сообщении.

[Meta2]

Sub ПрочесатьМестность()
'запретим перерисовку
Application.ScreenUpdating = False

Dim sCompany, sDuty, sAddress, sWWW, sEmail, sPhone, sFax, sTemp, hvost, domain As String
Dim iStep, iMatch, iLen As Integer

iStep = 1
For i = 1 To 149
    FileName = "D:\123456\xls\bak\" & i & ".xls"
    Set Wb = Application.Workbooks.Open(FileName)
   
    'обнуляем строки
    sName = ""
    sCompany = ""
    sDuty = ""
    sAddress = ""
    sWWW = ""
    sEmail = ""
    sPhone = ""
    sFax = ""
   
    'явно обозначим имя
    sName = Wb.Sheets(1).Cells(22, 4).Value
        
    For j = 24 To 40
        'только если в строке что-то есть
        If (Wb.Sheets(1).Cells(j, 4).Value <> "") Then
            'инициализировали строку
            sTemp = Wb.Sheets(1).Cells(j, 4).Value
            
            'ищем место работы
            If (sTemp = "Место работы:") Then
                'непосредственно название компании
                For k = 5 To 24
                    If (Wb.Sheets(1).Cells(j, k).Value <> "") Then
                        sCompany = Wb.Sheets(1).Cells(j, k).Value
                    End If
                Next k
            End If
    
            'ищем должность
            iMatch = InStr(sTemp, "Должность: ")
            If (iMatch <> 0) Then
                'ищем "предыдущее место работы"
                iMatch = InStr(sTemp, "Должность: предыдущее место работы")
                            
                'если это нормальное место работы, т.е. слов "предыдущее место работы" нету
                If (iMatch = 0) Then
                    iLen = Len(sTemp)
                    hvost = Right(sTemp, iLen - 11)
                    sDuty = hvost & Wb.Sheets(1).Cells(j + 1, 4).Value
                End If
            End If
            
            'ищем адрес
            iMatch = InStr(sTemp, "Адрес: ")
            If (iMatch <> 0) Then
                'нужна только Москва
                iMatch = InStr(sTemp, "осква")
                'если это Москва
                If (iMatch <> 0) Then
                    iLen = Len(sTemp)
                    hvost = Right(sTemp, iLen - 7)
                    sAddress = hvost & Wb.Sheets(1).Cells(j + 1, 4).Value
                End If
            End If
            
            'ищем email
            iMatch = InStr(sTemp, "Адрес e-mail: ")
            If (iMatch <> 0) Then
                iLen = Len(sTemp)
                hvost = Right(sTemp, iLen - 14)
                'поиск почтового домена
                For k = 5 To 24
                    If (Wb.Sheets(1).Cells(j, k).Value <> "") Then
                        domain = Wb.Sheets(1).Cells(j, k).Value
                    End If
                Next k
                hvost = hvost & "@" & domain
                sEmail = hvost
            End If
            
            'опознали телефон, переместили
            iMatch = InStr(sTemp, "Тел.: ")
            If (iMatch <> 0) Then
                iLen = Len(sTemp)
                hvost = Right(sTemp, iLen - 5)
                sPhone = hvost
            End If

            'опознали факс, переместили
            iMatch = InStr(sTemp, "Факс: ")
            If (iMatch <> 0) Then
                iLen = Len(sTemp)
                hvost = Right(sTemp, iLen - 6)
                sFax = hvost
            End If
            
            'ищем сайт компапнии
            If (sTemp = "Сайт компании:") Then
                'непосредственно адрес сайта
                For k = 5 To 24
                    If (Wb.Sheets(1).Cells(j, k).Value <> "") Then
                        sWWW = Wb.Sheets(1).Cells(j, k).Value
                    End If
                Next k
            End If
        End If
    Next j
    
    'если это московская компания
    If (sAddress <> "") Then
        Cells(iStep, 1) = sName
        Cells(iStep, 2) = sCompany
        Cells(iStep, 3) = sDuty
        Cells(iStep, 4) = sEmail
        Cells(iStep, 5) = sPhone
        Cells(iStep, 6) = sFax
        Cells(iStep, 7) = sWWW
        Cells(iStep, 8) = sAddress
        iStep = iStep + 1
    End If
    
    Wb.Close SaveChanges:=False
Next i
End Sub

[EducatedFool]

If (sAddress <> "") Then
            Cells(iStep, 1) = sName
            Cells(iStep, 2) = sCompany
            Cells(iStep, 3) = sDuty
            Cells(iStep, 4) = sEmail
            Cells(iStep, 5) = sPhone
            Cells(iStep, 6) = sFax
            Cells(iStep, 7) = sWWW
            Cells(iStep, 8) = sAddress
            iStep = iStep + 1
        End If

записывает значения в ячейки АКТИВНОЙ книги, коей в момент работы макроса является обрабатываемая книга (а не та, в которую должны попасть данные)

А обрабатываемую книгу Вы закрываете без сохранения: Wb.Close SaveChanges:=False

Вот и причина исчезновения данных...

[EducatedFool]

И ещё: код можно упростить и ускорить, если учесть следующее:

Wb.Sheets(1).Cells(j, k).Value вычисляем ОДИН раз, а потом полученное значение используем внутри цикла.
x=Sheets(1).Cells(j, k)

Нет смысла обращаться через Wb, поскольку книга, открытая кодом Set Wb = Application.Workbooks.Open(Filename ), автоматически становится активной.

А вот ссылку на итоговую книгу, в которую заносятся данные, необходимо запомнить:

Sub ПрочесатьМестность()
    Dim sh As Worksheet: Set sh = ActiveSheet

и потом записывать значения ИМЕННО НА ЭТОТ ЛИСТ:

        'если это московская компания
        If Len(sAddress) Then
            sh.Cells(iStep, 1).Resize(, 8) = _
                     Array(sName, sCompany, sDuty, sEmail, sPhone, sFax, sWWW, sAddress)
            iStep = iStep + 1
        End If

Ну и вместо циклов типа

                    For k = 5 To 24
                        If (Wb.Sheets(1).Cells(j, k).Value <> "") Then
                            sCompany = Wb.Sheets(1).Cells(j, k).Value
                        End If
                    Next k
                End If

лучше использовать поиск (метод Find)

[Meta2]

Ага, понятно...

то-то Excel у меня запрашивает подтверждение на сохранение данных.

А как мне записать данные в нужную книгу, а не в текущую? (Дело в том, что я в VBA, как свинья в апельсинах - программирую с книжкой в руке)

[Meta2]

Просто я на С долго программировал, мне плохо знакома объектная модель Excel, мне надо сделать один раз, чтобы один же раз отработало.

[Meta2]

о, заработало!!!

EducatedFool, можно вас как-то отблагодарить? Репутацию повысить или что-то в этом духе?