Страницы: 1
RSS
макрос замены всех формул на всех листах на значения
 
Добрый день.  
 
Когда-то поднимал эту тему на форуме, чтобы:  
во всех файлах .xls в указанной папке, необходимые листы в книге заменять на значения... часть листов удалять... часть строк обрезать и т.п.  
 
Сейчас встала проблема, чтобы был макрос который во всех файлах .xls независимо от наименования листов менял все формулы на значения.  
 
Т.е. чтобы в определенную папку загрузить кучу файлов и на выходе получить абсолютно на всех листах в книге (в файле) значения вместо формул.  
 
На всякий случай в приложении к письму тот макрос, которым пользуюсь сейчас.  
 
Заранее спасибо за помощь.
 
Товарищи, если кто-то может, очень прошу - помогите пожалуйста! 845 файлов руками очищать от формул застрелюсь!
 
Чего вы нервничаете,я не пойму. У вас в макросе уже прозводится замена формул на значения (.Value=.Value). Что вам еще нужно?
 
Макрос заменяет все формулы на значения во всех файлах на всех листах в указанной папке  
 
 
Sub УдалитьВсеФормулыВПапке()  
Dim fd As FileDialog  
Dim iPath As String  
Dim iFileName As String  
Dim iSheet As Worksheet  
 
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)  
   ChDir "C:\"  
   With fd  
       .ButtonName = "Выбрать"  
       If .Show = -1 Then  
           iPath = .SelectedItems(1) & Application.PathSeparator  
       Else  
           Exit Sub  
       End If  
   End With  
   Set fd = Nothing  
     
   If MsgBox("Во всех документах Excel в папке " & iPath & " на всех листах формулы будут заменены на значения!" & Chr(13) & "Вы уверены ???", vbOKCancel + vbExclamation, "Подтверждение") = vbCancel Then Exit Sub  
   If MsgBox("Вы отдаёте себе отчёт, что формулы во всех файлах будут удалены?", vbOKCancel + vbExclamation, "Подтверждение") = vbCancel Then Exit Sub  
     
   With Application  
       .ScreenUpdating = False  
       .Calculation = xlCalculationManual  
       '.EnableEvents = False  
       iFileName = Dir(iPath & "*.xls")  
       Do While iFileName$ <> ""  
           With Workbooks.Open(Filename:=iPath & iFileName, UpdateLinks:=0)  
               For Each iSheet In .Sheets  
                   With iSheet.UsedRange  
                       .Value = .Value  
                   End With  
               Next  
           .Close saveChanges:=True  
           End With  
           iFileName$ = Dir  
       Loop  
       .EnableEvents = True  
       .Calculation = xlCalculationAutomatic  
       .ScreenUpdating = True  
   End With  
       MsgBox "Во всех документах Excel в папке " & iPath & " на всех листах формулы были заменены на значения!", 64, "Конец"  
End Sub
 
Павел, уже неоднократно помогали и помогать продолжаете, огромное Вам спасибо.
 
Привествую, а можете помочь, не понимаю в программировании, но на работе аналогичный макрос очень бы облегчел жинь,  
 
задача меньше: на текущем листе снимать (заменять на значения) только формулу ВПР или СуммЕсли  
 
хотелось бы чтобы при запуске макроса он сначала спросил какую из этих формул надо заменить.  
 
работаю как в 3 так и в 7 экселе с массивами по несколько сотен тысяц строк. а еще иногда сложные таблицы и сидеть снимать формулы в отдельных ячеках с этими формулами стреляюсь.  
 
предполагаю что можно выше написанны макрос переделать под это, но не знаю как =(  
 
плиз, хэлп...
 
{quote}{login=алена}{date=21.04.2011 10:37}{thema=}{post}Привествую, а можете помочь, не понимаю в программировании, но на работе аналогичный макрос очень бы облегчел жинь,  
 
задача меньше: на текущем листе снимать (заменять на значения) только формулу ВПР или СуммЕсли  
 
хотелось бы чтобы при запуске макроса он сначала спросил какую из этих формул надо заменить.  
 
работаю как в 3 так и в 7 экселе с массивами по несколько сотен тысяц строк. а еще иногда сложные таблицы и сидеть снимать формулы в отдельных ячеках с этими формулами стреляюсь.  
 
предполагаю что можно выше написанны макрос переделать под это, но не знаю как =(  
 
плиз, хэлп...{/post}{/quote}
 
Так например:  
 
Sub tt()  
Dim Rng As Range, vl, cnt  
 
vl = MsgBox("ВПР() менять?", vbYesNo)  
cnt = MsgBox("СУММЕСЛИ() менять?", vbYesNo)  
 
If vl + cnt < 14 Then ' чтоб не делать лишнюю работу  
For Each Rng In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)  
If vl = 6 Then  
If InStr(Rng.Formula, "VLOOKUP") > 0 Then Rng.Value = Rng.Value  
End If  
 
If cnt = 6 Then  
If InStr(Rng.Formula, "COUNTIF") > 0 Then Rng.Value = Rng.Value  
End If  
 
Next  
End If  
 
End Sub  
 
 
 
Только замените "VLOOKUP" и "COUNTIF" на русское написание - я на англ. тестил.
 
{quote}{login=Hugo}{date=21.04.2011 11:35}{thema=}{post}Так например:  
Только замените "VLOOKUP" и "COUNTIF" на русское написание - я на англ. тестил.{/post}{/quote}  
 
В VBA все функции пишутся на буржуйском.
 
Да, с подсказки NullUzer лучше так (да и формулы я там выше спутал...):  
 
Sub tt()  
Dim Rng As Range, vl, cnt  
 
vl = MsgBox("ВПР() менять?", vbYesNo)  
cnt = MsgBox("СУММЕСЛИ() менять?", vbYesNo)  
 
If vl + cnt < 14 Then ' чтоб не делать лишнюю работу  
For Each Rng In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)  
If vl = 6 Then  
If Mid$(Rng.Formula, 2, 7) = "VLOOKUP" Then Rng.Value = Rng.Value  
End If  
 
If cnt = 6 Then  
If Mid$(Rng.Formula, 2, 5) = "SUMIF" Then Rng.Value = Rng.Value  
End If  
 
Next  
End If  
 
End Sub  
 
Да, про буржуйский точно, я просто не уверен был, какую строку вернёт код в русской локали.
 
Т.е. не в локали, а в версии.  
У NullUzer там выбор формул не работает. Т.е. выбор есть - толку нет...
 
{quote}{login=Hugo}{date=21.04.2011 11:53}{thema=}{post}Т.е. не в локали, а в версии.  
У NullUzer там выбор формул не работает. Т.е. выбор есть - толку нет...{/post}{/quote}  
Поясни, чего у меня не работает? Всё нормально работает, только я сделал замены для ВПР и СУММ, а в форме сделал выбор. Короче, нужно просто сделать одну процедуру. :)  
 
Sub DoConvert()  
   Dim rng As Range  
   Dim i As Double  
     
   Set rng = ActiveSheet.UsedRange  
     
   With rng  
       For i = 1 To .Count  
           If .Cells(i).HasFormula Then  
               If Mid$(.Cells(i).Formula, 2, 7) = "VLOOKUP" Or Mid$(.Cells(i).Formula, 2, 5) = "SUMIF" Then  
                   .Cells(i).Value = .Cells(i).Value  
               End If  
           End If  
       Next  
   End With  
End Sub
 
Ну а если я не хочу заменять ВПР()? Зачем там выбор, если заменяются оба?
 
Я ж написал, что это НЕ НУЖНО! Просто думал одно, а сделал другое. :) Нужно просто одна процедура. Я её написал. :)
 
алена просила  
"только формулу ВПР или СуммЕсли  
хотелось бы чтобы при запуске макроса он сначала спросил какую из этих формул надо заменить."  
Я так и сделал - сперва спрашивает: ВПР или СуммЕсли, как бонус можно обе :)
 
{quote}{login=Hugo}{date=21.04.2011 12:42}{thema=}{post}алена просила  
"только формулу ВПР или СуммЕсли  
хотелось бы чтобы при запуске макроса он сначала спросил какую из этих формул надо заменить."  
Я так и сделал - сперва спрашивает: ВПР или СуммЕсли, как бонус можно обе :){/post}{/quote}  
 
Подправил. :)
 
для разнообразия :)
Живи и дай жить..
 
Н-да...
 
СПАСИБОЧКИ ВСЕМ ОГРОМНОЕ!!!  
Очень очень выручили =)  
 
есть же люди у которых руки от куда нада растут =)
Страницы: 1
Читают тему
Наверх