Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
макрос изменяющий имена листов, что необходимо добавит в макрос, чтобы он изменял имена только выделенных листов
 
обрый день, эксельэксперты, помогите пожалуйста. Уже много лет у меня живет макрос, изменяющий имена листов на значения из ячеек., у него возникло уже много модификаций, но не могу понять что необходимо изменить, чтобы он менял имена только выделенных листов. Помогите, пожалуйста! Спасибо!
Код
Sub RenameSheets()

Dim sh As Worksheet

For Each sh In Sheets

sh.Name = sh.Range("O1").Value
Next

End Sub
Изменено: Стешка - 26.07.2023 13:05:34
Можно ли ускорить макрос?, Макрос заполнения медленно работает
 
Уважаемые знатоки Excel.

Подскажите, пожалуйста, есть макрос, который
проставляет в столбце А восклицательный знак. А потом шрифт в столбце меняет на
белый Но почему-то очень медленно, на 1000 строк уходит около 10 минут. А с
учётом того, что у меня файлы по 31 тыс. строк, то он у меня будет работать
часами. Можно ли его как-то ускорить? спасибо! Файл приложить не могу, т.к даже
заархивированная пустой файл с одним листом весит 12КБ.
Код
Sub Заполнение()

Dim i As Long

Dim kolvo As Variant

  Dim list As Worksheet

  kolvo = InputBox("Укажите необходимое количество строк")

For i = 1 To kolvo

Cells(i, 1) = "!"

Next

Columns("A:A").Select

    Range("A1").Activate

    With Selection.Font

        .ThemeColor =
xlThemeColorDark1

        .TintAndShade = 0

        End With

       

End Sub
Изменено: Стешка - 16.06.2023 11:46:28
Округлить слагаемые таким образом, чтобы выйти на округленную сумму
 
Уважаемые дамы и господа!
Передо мной встала, казалось бы, простенькая задачка. Есть список сумм в рублях, есть итог по этим суммам в рублях, если данный итог округлить до миллионов получаем некую сумму. В соседнем столбце каждая из сумм округлена до миллионов с одним знаком после запятой и, так же, подбит итог. И вот этот итог не совпадает с суммой в рублях, округлённой до миллионов с одним знаком после запятой, что в общем-то, вполне себе объяснимо и естественно, но очень не удобно. Приходится "гонять" десятые, что отнимает очень много сил и времени. Может быть кто-нибудь знает, как прописать формулу, чтобы округленная сумма в рублях совпадала с суммой в миллионах?
Заранее благодарна за любую идею.
Поиск решения: Максимизировать полезность рациона при ограничении суммарных затрат
 
Уважаемые форумчане! Помогите, пожалуйста, понять. Начальник начальника сегодня сдает зачет. Попросила по быстренькому решить задачки в Excel с использованием "Поиска решения". Переслали мне задачки (25 листов) а они сформулированы так, что я не то, что решить, я вообще не могу понять, что хотят-то?
Где переменные, где ограничения, где что?

Прилагаю задачку. На листе 1 формулировка задания, на втором - копия в Excel с формулами которые успела подставить. А дальше не могу понять. Ну ладно, место для целевой обозначено. А что считать переменными и какие накладывать условия в сценарии - не понятно.
Помогите, пожалуйста, если кто-нибудь, что-нибудь в этом понимает. Заранее очень благодарна.

второй вопрос удален [МОДЕРАТОР]
Изменено: Стешка - 23.11.2017 21:05:53
Список файлов из папки с гиперссылками
 
Всем доброго дня! Помогите, пожалуйста, еще раз, не пойму, что случилось. Я как-то на просторах форума старого форума нашла чудеснейший макрос, который создавал список из файлов из конкретной папки с гиперссылками на эти файлы. Я его чуть-чуть переделала, чтобы путь к папке на листе указывать, и в 2003 все замечательно работало. А в 2010 перестало, причем, ругается на первую же строчку.
Код
Sub qq()
With Application.FileSearch
.LookIn = Cells(1, 1)
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
For i = 2 To .FoundFiles.Count
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _
TextToDisplay:=.FoundFiles(i)
Next
End With
End Sub

Ну, и до кучи, подскажите, пожалуйста, как подправить  «.LookIn =», чтобы не надо было в ячейке А1 указывать папочку, а чтобы список составлялся из папки в который лежит файлик с макросом.
Заранее Вам ОЧЕНЬ благодарна.
Сбросить цвета в Excel 2010
 
Добрый день всем! Помогите, пожалуйста, неучу. Ни в руководстве, ни на форуме ответ не нашла.  
В Excel 2003 если что-то случалось с палитрой, можно было сбросить цвета через сервис:    
Сервис – параметры – цвета - сброс. А как тоже самое сделать в Excel 2010?  
Заранее Вам благодарна.
Переименовать лист во всех файлах в папке
 
Добрый день, Уважаемые!    
Подскажите, пожалуйста, можно ли написать такой макрос, который переименовывал  бы во всех файлах в папке лист в название файла. Сейчас попытаюсь расшифровать написанное. Например, есть папка, в которой 3 файла: «Январь», «Февраль», «Март». В каждом из этих файлов по одному листу: «TDSheet». Было бы здорово, если бы макрос смог переименовать в файле «Январь» лист из «TDSheet» в лист «Январь», в файле «Февраль» в «Февраль», ну и т.д. Только не ругайтесь, пожалуйста, что я сама даже не начала его писать, я алгоритм, по которому он должен  работать, и тот  придумать не могу.
Один файл открывается дважды
 
Добрый день!  
Помогите, пожалуйста. Я что-то нажала, и один и тот же файл открывается дважды с именами:  
Пример.xls:1  
Пример.xls:2  
А как убрать эту штуку я забыла и на форуме не нашла. Помогите, пожалуйста. Заранее всем благодарна. (Файл прикладываю)
Удаление строк по всему файлу.
 
Добрый день! На форуме был макрос (за что спасибо огромное за это Вам, Pavel55!!!), который удаляет строки по условию. Но удаляет он их только на активном листе. А мне нужно по всему файлу. Я не придумала ничего умнее, как ввести переменную для листа, чтобы по условию перебирались листы файла. Но это неудобно, так как макрос «удаления» заново запускается на каждом листе, следовательно, заново надо отвечать на его вопросы. А как бы так «подкрутить» этот макрос, чтобы он сам понимал, что строчки нужно удалить по всему файлу? Подскажите, пожалуйста. Заранее спасибо!!! (Пример прилагаю)
Как разбить файл по листам, сохранив, при этом, ссылки листов друг на друга?
 
Добрый день! Подскажите, пожалуйста, как можно быстро разбить файл по листам, сохраняя при этом ссылки в листах друг на друга. В PLEX есть подобная функция, но она оставляет ссылки в листах на исходный файл, а мне нужно, чтобы листы друг на друга ссылались. Заранее всем спасибо!
[оффтоп] С Праздником, Защитники!
 
Уважаемые представители сильной половины Планеты! Поздравляю Вас праздником!    
Пусть в Вашей жизни не будет печали, а удача станет самой верной спутницей! Пусть жизнь дарит тысячи счастливых возможностей, и каждая из них будет использована на все сто. Пусть все тревоги и ненастья стороной обходят Ваш дом и Ваши семьи, а богатырское здоровье будет неотъемлемой частью! Пусть работа приносит не только удовольствие, но и заработок. Пусть каждый новый день будет похож на предыдущий только в одном - он будет таким же счастливым! Радости, удачи, вдохновения!
Два разных Excel, которые не видят друг друга.
 
Добрый день! Подскажите, пожалуйста, может кто-нибудь сталкивался. Мне установили 2007 Excel рядом с 2003 Excel. После этого с некоторыми файлами 2003  произошла какая-то беда. У них даже иконки при открытии разные стали (вид иконок прикладываю).    
Это, конечно, не имело бы никакого значения, но вся проблема в том, что файлы этих 2-х видов не видят друг друга, соответственно, из одного файла даже нельзя сослаться на другой. Проблему, конечно, можно решить, если открыть Excel, и все остальные файлы открывать через  «Файл-Открыть», но это не всегда бывает удобно. Может кто-нибудь знает, как решить данную проблему. Буду очень благодарна.
ОФФ. С наступающим Новым годом!
 
Уважаемые форумчане!  
Поздравляю Вас с наступающим Новым годом!  
Желаю Вам, чтобы в новом году оправдались все Ваши надежды и исполнились желания. Процветания и благополучия Вам и Вашей семье!  
Спасибо Вам, за то, что Вы есть!
Копирование, при большом количестве условий.
 
Подскажите, пожалуйста, с чего начинать реализацию моей очередной «хочухи», и можно ли ее вообще реализовать. А если кто-нибудь мне поможет с написанием макроса, буду очень благодарна!  
Есть некий файл. И если на листе «Свод» в столбце С в строках с 452 по 760 в желтых ячейках стоит сумма большая 100 000 или меньшая -100 000, необходимо, чтобы на лист «Итог» начиная со столбца D и далее копировались столбцы с листов «Лист1» - «Лист4», начиная со столбца D и далее,  у которых в соответствующей строке стоит не пустая сумма. При этом, столбцы должны копироваться только один раз, и в строке 2 должно быть имя листа, с которого «прилетел» столбец….Файл-пример прилагаю, Он сделан для двух строк 353 и 363. Я вообще не могу понять, как наложить условие «желтых строк» и чтобы столбец копировался только один раз. Да и с остальным не очень получается…  
Гуру! Пожалуйста, если реализация требует «высшего пилотажа», сообщите мне об этом. Работа срочная, я лучше тогда руками соберу.
Клонировать файл. Помогите, пожалуйста, добрым советом.
 
Добрый день всем. Дайте, пожалуйста, добрый совет. Ситуация следующая. Существует файл, состоящий из, примерно, 40 листов. Все листы разные. Куча формул (несколько тысяч на листе может быть), форматов и имен диапазонов.  При его заполнении начинает «висеть», причем так, что после нажатия «Enter» может думать до четверти минуты. Файл живет уже несколько лет, заполняется заново ежеквартально. Руководство решило, что лучший способ ускорения его работы полностью переписать (со всеми формулами, именами, форматами). Подскажите, пожалуйста, поможет ли это, если я уже удалила все лишние имена и форматы (графические объекты, правда, не помню как), или я буду делать Сизифов труд? И существует ли другой способ «лечения» такой болезни? Буду очень благодарна, так как перспектива переписать этот файл заново меня очень пугает.
ОФФ. Москвичи! Откликнитесь, пожалуйста, что все живы - здоровы.
 
Модераторы, простите за такую тему, можете меня наказать, но сердце не на месте!  
Форумчане-москвичи, жители Подмосковья, гости столицы, откликнитесь, пожалуйста, что все живы-здоровы.
Оффтоп. С Днем Защитника!!!
 
Уважаемая Сильная Половина Планеты!  
От всей души поздравляю Вас с Днем защитника Отечества!  
Желаю Вам силы духа, семейного уюта, комфорта на работе, легких денег,  всех мыслимых и немыслимых благ, и конечно, творить на радость нам!
Куда вставить ускоритель?
 
Добрый вечер всем. Извините, за название темы, но по-другому уже не формулируется.    
Есть некий макрос, который копирует данные из многих листов на один. (В файле он на листе «abridgement»).  Я знаю, что чтобы его «убыстрить» нужно в начало поставить:  
 
Application.Calculation = xlManual  
Application.ScreenUpdating = False  
 
А в конец:  
Application.Calculation = xlAutomatic  
Application.ScreenUpdating = True  
 
Но, когда я это вставляю, то на листе «abridgement» вместо сбора данных со всех листов копируется только 12 строчка напротив всех договоров.  (Файл я выложила без вставки).    
Подскажите, пожалуйста, кто знает, что делают эти штуки и в какое место их нужно вставлять.  
 
Заранее Всем благодарна.  
 
P.S. пример достаточно быстро отработает, но в реальном файле более 100 листов. С ума сойти можно, особенно, когда в сети обновить нужно.
Копирование форматов
 
Добрый день. Помогите, пожалуйста. Есть некий макрос, который копирует данные из другой книги.  
 
Sub Obnovka()  
     
   Cells(4, 10) = "Íå îáíîâëåí!!!"  
   Cells(4, 10).Font.ColorIndex = 3  
     
     
   Range(Cells(10, 6), Cells(350, 20)).ClearContents ' Äèàïàçîí ÿ÷ååê äëÿ î÷èñòêè  
   ' thisbook - ïåðåìåííàÿ (íàçûâàåì ñàìè), ïîñëå "=" âñòðîåííûå îáúåêòû  
   thisbook = ActiveWindow.Caption  
     
   FileName1 = Cells(2, 4).Value  
   Sheetname1 = Cells(3, 4).Value  
   ' Workbooks.Open FileName - âñòðîåííûå îáúåêòû  
   Workbooks.Open FileName:=FileName1, UpdateLinks:=0  
     
   ' WS - ïåðåìåííàÿ  
   For Each WS In ActiveWorkbook.Worksheets  
       If WS.Name = Sheetname1 Then  
           SheetExists = True  
       End If  
   Next  
         
         
   If SheetExists <> True Then  
       MsgBox "Íåò ëèñòà " & Sheetname1 & " â êíèãå " & FileName1  
       ActiveWorkbook.Close savechanges:=False  
     
       GoTo oblom  
   End If  
         
   Worksheets(Sheetname1).Select  
   thatbook = ActiveWindow.Caption  
       
       
   Range(Cells(14, 2), Cells(10000, 60)).Select  
   Selection.Copy  
   Windows(thisbook).Activate  
   Range("B8").Select  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   Windows(thatbook).Activate  
   Range("B8").Select  
   Selection.Copy  
         
   ActiveWorkbook.Close savechanges:=False  
     
Cells(4, 10) = Date & " " & "â" & " " & Time  
Cells(4, 10).Font.ColorIndex = 5  
 
Range("C10").Select  
     
oblom:  
'ìåòêà äëÿ âûõîäà  
End Sub  
 
Но, копирует он только значения. Подскажите, пожалуйста, где что вставить, чтобы он еще и форматы копировал.  
Заранее благодарна.
Правильно задать условное форматирование
 
Добрый день!  
Помогите, пожалуйста, правильно задать условное форматирование. Необходимо получить следующий вид:  
1) Если четная и нечетная строка одного столбца пустые, обе ячейки в столбце должны закраситься красным.  
2) Если в четной строке 1 – ячейка должна закраситься желтым.  
3) Если в нечетной строке 1 – ячейка должна закраситься зеленым.  
4) Обратный порядок строк (нечетная, четная) не учитываеться.  
Что-то я себе всю голову сломала, а ничего не получается.  Пример прилагаю.  
Заранее Всем благодарна.
Макрос, переименовывающий избранные листы.
 
Добрый день всем. Помогите, пожалуйста, довести до ума макрос. Есть некий файл с листами: Лист1, Лист2, Лист3, АБВ-01, АБВ-02, АБВ-08, АБВ-09. Собрала я, как пазл, из чужих макросов свой, который мне листы, начинающиеся с АБВ переименовывает в ГДЕ-01, ГДЕ-02, ГДЕ-08, ГДЕ-09.  А мне бы очень хотелось чтобы он переименовывал эти листы по порядку: ГДЕ-01, ГДЕ-02, ГДЕ-03, ГДЕ-04, а исходящие листы могли бы иметь названия типа АБВ-01 (2), АБВ-01 (3), АБВ-01 (4). Помогите, пожалуйста. (Отдельно макрос и пример с макросом прикладываю):  
Sub RenameSheetsÀÁÂ()  
 
   Dim i As Integer  
   Dim input_sheet_name, main_sheet As Object  
 
   Const number_of_companies As Integer = 9  
   Const short_sheet_name As String = "АБВ-"  
     
     
   Set main_sheet = ActiveSheet  
 
       For i = 1 To number_of_companies  
           If i < 10 Then  
           input_sheet_name = short_sheet_name & "0" & i  
           Else  
           input_sheet_name = short_sheet_name & i  
             
           End If  
               If Not SheetExists(input_sheet_name) Then  
                   MsgBox "Â ôàéëå íåò ëèñòà ñ èìåíåì '" & input_sheet_name & "' !"  
               Else  
                   Worksheets(input_sheet_name).Activate  
                   If i < 10 Then  
                   Worksheets(input_sheet_name).Name = "ГДЕ-" & "0" & i  
                   Else  
                   Worksheets(input_sheet_name).Name = "ГДЕ-" & i  
                   End If  
               End If  
       Next i  
         
   main_sheet.Activate  
 
End Sub  
 
Private Function SheetExists(sname) As Boolean  
   Dim x As Object  
   On Error Resume Next  
   Set x = ActiveWorkbook.Sheets(sname)  
       If Err = 0 Then SheetExists = True Else SheetExists = False  
End Function  
 
Заранее благодарна.
И снова об удалении имен
 
Добрый день! Помогите, пожалуйста.    
На форуме не раз поднималась тема об удалении имен. У меня есть файл (прикладываю) в котором имена ну ни как не хотят удаляться. (Перепробовала штук 7 разных макросов, которые нашла на сайте). Подскажите, пожалуйста, в чем тут может быть дело.
Макрос, копирующий необходимые данные
 
Добрый день!    
Помогите, пожалуйста, сама зашла в тупик. Второй день бьюсь.    
Итак. Существует некий макрос, который при выполнении определенных условий копирует данные из нескольких листов в один сводный (точнее  два макроса, но это несущественные детали):  
 
Sub TR()  
 
Dim i, j, n, p As Integer  
   
 For i = 18 To 2000 Step 1  
     
  If Cells(i, 1) = "Торговая Дебиторская задолженность" Then  
     
   Sheet60.Cells(m, 2) = Cells(i, 2)  
   Sheet60.Cells(m, 3) = Cells(i, 3)  
   Sheet60.Cells(m, 4) = Cells(i, 4)  
   Sheet60.Cells(m, 5) = Cells(i, 5)  
   Sheet60.Cells(m, 6) = Cells(i, 6)  
   Sheet60.Cells(m, 7) = Cells(i, 7)  
   Sheet60.Cells(m, 8) = Cells(i, 8)  
   Sheet60.Cells(m, 9) = Cells(i, 9)  
   Sheet60.Cells(m, 10) = Cells(i, 10)  
   Sheet60.Cells(m, 11) = Cells(i, 11)  
   Sheet60.Cells(m, 12) = Cells(i, 12)  
   Sheet60.Cells(m, 13) = Cells(i, 13)  
   Sheet60.Cells(m, 14) = Cells(i, 14)  
   Sheet60.Cells(m, 15) = Cells(i, 15)  
   Sheet60.Cells(m, 16) = Cells(i, 16)  
   Sheet60.Cells(m, 17) = Cells(i, 17)  
   Sheet60.Cells(m, 18) = Cells(i, 18)  
   Sheet60.Cells(m, 19) = Cells(i, 19)  
   Sheet60.Cells(m, 20) = Cells(i, 20)  
   Sheet60.Cells(m, 21) = Cells(i, 21)  
   Sheet60.Cells(m, 22) = Cells(i, 22)  
   Sheet60.Cells(m, 23) = Cells(i, 23)  
   Sheet60.Cells(m, 24) = Cells(i, 24)  
   Sheet60.Cells(m, 25) = Cells(i, 25)  
   Sheet60.Cells(m, 26) = Cells(i, 26)  
   Sheet60.Cells(m, 27) = Cells(i, 27)  
     
   m = m + 1  
     
  End If  
     
 Next i  
   
 End Sub  
 
В принципе, он работает, Но очень медленно. А не получается у меня заменить длинный столбец одной строчкой. Я пыталась цикл еще один написать, столбец через переменную  j обозначить и значения ей присвоить от 2 до 27.  
 
Sub TR()  
 
Dim i, j, n, p As Integer  
   
 For i = 18 To 2000 Step 1  
 
For j = 2 To 27 Step 1  
 
     
  If Cells(i, 1) = "Торговая Дебиторская задолженность" Then  
     
   Sheet60.Cells(m, j) = Cells(i, j)  
         
   m = m + 1  
     
  End If  
 
Next j  
     
 Next i  
   
 End Sub  
 
 
так он мне все данные по разным строкам разносить начал. А что я не так делаю, понять не могу. Помогите, пожалуйста!!! (Пример прилагаю).  
Заранее всем благодарна.
Разорвать связи, не открывая файл.
 
Добрый день всем!  
Подскажите пожалуйста, существует ли способ разорвать в файле все связи, не открывая его?  
Что я имею в виду: существует итоговый файл, который ссылается на n-ное количество других файлов. Периодически ссылки вместо цифр выдают «#ЗНАЧ», и чтобы восстановить данные нужно открыть фай-источник. Для нормальнй работать с итоговым файлом, я копирую его в отдельную папку, разорвав предварительно в нем все связи обычным путем (т.е. войдя в файл, открыв все файлы-источники, если данные из них пошли «#ЗНАЧ»-ами, далее через «Правка»- «Связи»)  . Вопрос. Можно ли каким-нибудь образом разорвать в файле все связи, на открывая его?
И снова списки!
 
Добрый день всем!    
Поискала на форуме, но ответ не нашла!  
Помогите, пожалуйста. Вопрос в файле. Заранее Всем спасибо!
Сумма ячеек по всем листам
 
Добрый день всем!  
Сразу прошу прощения, если вопрос глупый – 4 день с работы практически не ухожу.  
Если у меня есть файл с листами 1, 2, 3, 4, 5 просуммировать ячейку F14 по листам  с 2 по 5 я могу следующей формулой:  
 
=СУММ('1:2'!F14)  
 
А как мне написать формулу или что-нибудь еще, если на момент на писания нет точного количества листов? Например в процессе добавятся листы 6, 7, АВ, ВХ и т д. и все, кроме 1-го мне нужно просуммировать?
Собрать информацию блоками на одном листе
 
Добрый день всем!  
Помогите, пожалуйста! Вопрос в файле.  
Заранее благодарна за помощь и/или внимание.
Воскрешение файлов
 
Добрый день всем!  
Заранее прошу прощения за свой вопрос, но мне очень нужна ваша помощь.  
У нас грядет глобальная консолидация (предприятий 50 шт.) . ТМ пустые то весят 7,5 Мб, а когда их заполнят…В общем, явно, каждый второй файл дохнуть будет.  
Может кто-нибудь знает название программы, которая восстанавливала бы Excel-евские файлы со всеми форматами, рамочками, формулами, ссылками и прочими плюшечками?  
Заранее всем благодарна.
Гиперссылки и их "оживление"
 
Добрый день, знатокам Excel  и интересующимся!  
Опять к Вам с просьбой помочь чайнику.  
На сайте нашла замечательный макрос, изменяющий наименования ярлычков листов:  
 
Sub RenameSheetsENG()  
         
For Each sh In ActiveWorkbook.Worksheets  
sh.Name = sh.Range("O2").Value  
 
Next  
     
End Sub  
 
Одна неприятность – после его работы слетают все гиперссылки, даже если вернуть исходные названия.  
 
Подскажите, пожалуйста, можно ли этой беде помочь, и если «да», то как?  
 
Заранее всем благодарна.
Вставка данных в активную ячейку
 
Доброе утро, дамы и господа!  
Помогите, пожалуйста!  
Есть некий макрос, который прописывает  в одном файле полный путь к другому файлу.  
Проблема в том, что вставляет он эти данные в ячейку A8, а как сделать так, чтобы он вставлял их в активную яечейку?  
Заранее всем благодарна за помощь и внимание!  
 
Sub ExcelSearch()  
 
Dim fname As String  
Dim result As Integer  
With Application.FileDialog(1) ' ?????? : With Application.FileDialog(msoFileDialogOpen) '  
.Title = "Select Excel file"  
 
.InitialFileName = "C:\" 'default path'  
.AllowMultiSelect = False  
.Filters.Clear  
.Filters.Add "Pack files", "*.xls", 1  
result = .Show  
 
If result = 0 Then Exit Sub  
fname = Trim(.SelectedItems.Item(1))  
End With  
 
On Error Resume Next  
 
ActiveWorkbook.ActiveSheet.Range("A8") = fname  
 
 
 
End Sub
Страницы: 1 2 След.
Наверх