Jenya1980 (Автор тем)

Растянуть период на весь год

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 28.10.2025 14:49:06 Добрый день. Как в экселе растянуть ячейки по неделям до конца года в формате "29.12 - 04.01"? Спасибо.
	Перейти

Скопировать диапазон таблицы и перенести в WORD

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

28.09.2025 19:30:47

Добрый день.
Написал макрос, который копирует выделенный диапазон таблицы из Excel в Word
Но таблица встравляется в ворд и выходит за края. Как сделать, чтобы таблица была по ширине страницы

Код

Sub обработка()
    ' Диалоговое окно для выбора файла Excel
    Dim excelFilePath As String
    Dim i As Long
    Dim tblRange As Excel.Range


MsgBox ("Это снова я - твой помощник и мы начинаем" & vbCrLf & "Сейчас Вас система попросит выбрать файл Word, где хранится шаблон файла")





    ' Диалоговое окно для выбора файла шаблона Word
    Dim wordFilePath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Выберите файл шаблона Word"
        .Filters.Clear
        .Filters.Add "Word Documents", "*.docx"
        .AllowMultiSelect = False
        If .Show = -1 Then
            wordFilePath = .SelectedItems(1)
        Else
            MsgBox "Файл не выбран. Макрос завершен."
            Exit Sub
        End If
    End With

    On Error Resume Next
    Dim objWrdApp As Object
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0 ' Включить стандартную обработку ошибок обратно

    objWrdApp.Visible = True
    Dim objWrdDoc As Object
    Set objWrdDoc = objWrdApp.Documents.Open(wordFilePath)

iNomer = ThisWorkbook.Worksheets("Лист1").Cells(6, 1)

        ' Обновление закладок в Word данными из Excel
        With objWrdDoc
            .Bookmarks("Bookmark1").Range.Text = ThisWorkbook.Worksheets("Лист1").Cells(1, 2).Value
            .Bookmarks("Bookmark2").Range.Text = ThisWorkbook.Worksheets(iNomer).Cells(12, 4).Value
            .Bookmarks("Bookmark3").Range.Text = ThisWorkbook.Worksheets(iNomer).Cells(12, 5).Value
            .Bookmarks("Bookmark4").Range.Text = ThisWorkbook.Worksheets(iNomer).Cells(12, 6).Value


            ThisWorkbook.Sheets("Список ЛПУ").Range("A1:K1").AutoFilter Field:=6, Criteria1:="ПОЛИКЛИНИКА"
            ThisWorkbook.Sheets("Список ЛПУ").Range("A1:K1").AutoFilter Field:=3, Criteria1:=ThisWorkbook.Worksheets("Лист1").Cells(2, 1).Value
            ThisWorkbook.Sheets("Список ЛПУ").Range("A1:K1").AutoFilter Field:=5, Criteria1:=ThisWorkbook.Worksheets("Лист1").Cells(3, 1).Value

            ' Копирование отфильтрованных данных из Excel в Word

            'Находим последнюю строку на листе с данными
            lastRow = ThisWorkbook.Sheets("Список ЛПУ").Cells(ThisWorkbook.Sheets("Список ЛПУ").Rows.Count, "A").End(xlUp).Row

            ' Проверяем, применены ли фильтры и есть ли видимые строки после заголовка
            If ThisWorkbook.Sheets("Список ЛПУ").AutoFilterMode And ThisWorkbook.Sheets("Список ЛПУ").FilterMode Then
                ' Получаем диапазон видимых ячеек в столбцах 9 и 10 (I и J)
                'с учетом заголовка
                On Error Resume Next
                Set rngToCopy = ThisWorkbook.Sheets("Список ЛПУ").Range("I1:J" & lastRow).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0

                If rngToCopy Is Nothing Then
                    MsgBox "Нет данных, соответствующих критериям фильтра.", vbInformation
                    'Удаляем фильтры
                    On Error Resume Next
                    ThisWorkbook.Sheets("Список ЛПУ").ShowAllData
                    On Error GoTo 0
                    Exit Sub
                End If

                ' Копируем отфильтрованный диапазон
                rngToCopy.Copy

                ' Вставляем скопированные данные в Word (с сохранением форматирования)

                On Error Resume Next ' Обработка случая, когда закладка может не существовать
                Set PasteRange = objWrdDoc.Bookmarks("Bookmark5").Range
                On Error GoTo 0

                If PasteRange Is Nothing Then
                    MsgBox "Закладка 'Bookmark5' не найдена в Word-документе.", vbCritical
                    'Удаляем фильтры
                    On Error Resume Next
                    ThisWorkbook.Sheets("Список ЛПУ").ShowAllData
                    On Error GoTo 0
                    Exit Sub
                End If

                PasteRange.PasteExcelTable _
                                        LinkedToExcel:=False, _
                                        WordFormatting:=False, _
                                        RTF:=False


                Application.CutCopyMode = False 'Очистка буфера обмена
            Else
                MsgBox "Фильтры не применены или нет видимых данных после применения фильтров.", vbInformation
            End If

            'Удаляем фильтры
            On Error Resume Next
            ThisWorkbook.Sheets("Список ЛПУ").ShowAllData
            On Error GoTo 0

  End With

  'Очистка переменных
    Dim objWS As Object, objWB As Object, objExcel As Object
    Set objWS = Nothing
    Set objWB = Nothing
    Set objExcel = Nothing
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    Set PasteRange = Nothing
    Set rngToCopy = Nothing

  MsgBox "Данные успешно скопированы в Word!", vbInformation


MsgBox ("Ну я все сделал с этим файлом! До новых встреч")

End Sub

Изменено: Jenya1980 - 28.09.2025 20:21:22

Перейти

Разница между датами с учетом рабочего дня

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

21.07.2025 10:29:52

Добрый день.
Есть два столбца с датами (начала работы) и (окончание работы).
Как найти количество часов и минут между двумя столбацами с учетом рабочего дня с 9:00-18:00
К примеру, если если 21.07.2025 08:00 и 21.07.2025 19:00, то это 8 часов
Можно формулой или только макросом?
Спасибо.
Файл не могу прикрепить

Дата создания	Дата закрытия	Количество часов:минут между датами в рабочих часах с (9:00-18:00
18.07.2025 23:58
18.07.2025 23:50
18.07.2025 23:39
18.07.2025 23:38
18.07.2025 23:34
18.07.2025 23:33
18.07.2025 23:27
18.07.2025 23:26	18.07.2025 23:26

Изменено: Jenya1980 - 21.07.2025 11:05:36

Перейти

Объединение таблиц с учетом дат

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

30.05.2025 15:35:16

Добрый день
Есть 100 листов с одинаковым форматом таблицы на каждом, но с разным количеством дней.
Как объединить таблицы в одну, при этом вставлять в итоговую учитывая даты каждой таблицы.
То есть вставлять данные в итоговую с учетом столбца даты
Очень нужна помощь

Перейти

Как из группированной таблицы сделать таблицу, чтобы можно делать сводную

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

26.03.2025 21:36:29

Добрый день
Есть таблица (вложение). Пытаюсь макросом сделать правильную для формирования сводной.
Где каждая группировка - отдельный столбец
Но не получается
что я делаю не так?

Код

Sub ConvertGroupedDataToTable()

  Dim ws As Worksheet
  Dim lastRow As Long
  Dim i As Long, j As Long
  Dim groupLevel As Integer
  Dim outputRow As Long
  Dim outputColumn As Integer
  Dim headers() As String
  Dim headerCount As Integer
  Dim currentHeaderValues() As Variant

  ' Укажите лист, содержащий сгруппированные данные
  Set ws = ThisWorkbook.Sheets("Sheet1") ' Измените "Sheet1" на имя вашего листа

  ' Определите последнюю строку с данными
  lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

  ' Определите максимальный уровень группировки (предполагаем, что он равен кол-ву отступов)
  groupLevel = 0
  For i = 1 To lastRow
    If ws.Cells(i, 1).IndentLevel > groupLevel Then
      groupLevel = ws.Cells(i, 1).IndentLevel
    End If
  Next i

  ' Инициализация массивов
  ReDim headers(1 To groupLevel + 1) ' +1 для колонки с товаром
  ReDim currentHeaderValues(1 To groupLevel)
  headerCount = groupLevel + 1

  ' Определите заголовки столбцов (названия уровней группировки)
  For j = 1 To groupLevel
    headers(j) = "Уровень " & j ' Можно изменить на что-то более осмысленное
  Next j
  headers(groupLevel + 1) = "Товар"

  ' Создайте заголовки в новом листе
  Dim outputSheet As Worksheet
  Set outputSheet = ThisWorkbook.Sheets.Add
  outputSheet.Name = "Таблица для сводной"

  For j = 1 To headerCount
    outputSheet.Cells(1, j).Value = headers(j)
  Next j

  ' Инициализируем номер строки для вывода
  outputRow = 2

  ' Пройдитесь по каждой строке исходных данных
  For i = 1 To lastRow

    ' Определите уровень группировки текущей строки
    Dim currentLevel As Integer
    currentLevel = ws.Cells(i, 1).IndentLevel

    ' Если это не строка с подсуммой/итогом
    If Not ws.Cells(i, 1).Font.Bold Then

      ' Обновите значения заголовков для текущего уровня и выше
      For j = 1 To currentLevel
        currentHeaderValues(j) = ws.Cells(i, 1).Value
      Next j

      ' Если текущий уровень - максимальный (т.е. это "Товар")
      If currentLevel = groupLevel Then

        ' Запишите данные в выходной лист
        For j = 1 To groupLevel
          outputSheet.Cells(outputRow, j).Value = currentHeaderValues(j)
        Next j
        outputSheet.Cells(outputRow, groupLevel + 1).Value = ws.Cells(i, 1).Value ' Значение товара

        ' Переходим к следующей строке для вывода
        outputRow = outputRow + 1

      End If

    End If

  Next i

  MsgBox "Преобразование завершено.  Сводная таблица готова на листе '" & outputSheet.Name & "'."

End Sub

Изменено: Jenya1980 - 26.03.2025 21:37:27

Перейти

Как из ячейки excel перенести в Ворд с сохранение формата жирности текст

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

21.02.2025 15:50:29

Добрый день.
Есть макрос, который переносит данные из ячеек в WORD
Но при переносе данных теряется жирность части текста.
Как сделать, чтобы сохранить часть текста жирным, а часть нет (Как в ячейке)
Макрос ниже

Код

  ' Делаем ФИО жирным в столбце C.
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        searchString = ThisWorkbook.Sheets(1).Cells(i, 1).Value  ' ФИО из столбца А

        'Определяем позицию начала ФИО в ячейке С
        Dim startPos As Long
        startPos = InStr(1, ThisWorkbook.Sheets(1).Cells(i, 3).Value, vbLf & searchString)

        'Если ФИО обнаружено в ячейке С
        If startPos > 0 Then
            With ThisWorkbook.Sheets(1).Cells(i, 3).Characters(startPos, Len(searchString)).Font
                .Bold = True
            End With
        End If
    Next i


    MsgBox "Обработка завершена."
       
        
    MsgBox ("Это снова я - твой помощник и мы продолжаем" & vbCrLf & "Сейчас Вас система попросит выбрать файл Word, где хранится шаблон наклеек")

    ' Диалоговое окно для выбора файла шаблона Word
    Dim wordFilePath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Выберите файл шаблона Word"
        .Filters.Clear
        .Filters.Add "Word Documents", "*.doc"
        .AllowMultiSelect = False
        If .Show = -1 Then
            wordFilePath = .SelectedItems(1)
        Else
            MsgBox "Файл не выбран. Макрос завершен."
            Exit Sub
        End If
    End With

    On Error Resume Next
    Dim objWrdApp As Object
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0 ' Включить стандартную обработку ошибок обратно

    objWrdApp.Visible = True
    Dim objWrdDoc As Object
    Set objWrdDoc = objWrdApp.Documents.Open(wordFilePath)


    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    l = l + 1
        ' Обновление закладок в Word данными из Excel
        With objWrdDoc
            .Bookmarks("Bookmark_2").Range.Text = Cells(i, 3).Value
            .Bookmarks("Bookmark_3").Range.Text = Cells(i + 1, 3).Value
            .Bookmarks("Bookmark_4").Range.Text = Cells(i + 2, 3).Value
            .Bookmarks("Bookmark_5").Range.Text = Cells(i + 3, 3).Value
            .Bookmarks("Bookmark_6").Range.Text = Cells(i + 4, 3).Value
            .Bookmarks("Bookmark_7").Range.Text = Cells(i + 5, 3).Value
            .Bookmarks("Bookmark_8").Range.Text = Cells(i + 6, 3).Value

            .Bookmarks("Bookmark_9").Range.Text = Cells(i + 7, 3).Value
            .Bookmarks("Bookmark_10").Range.Text = Cells(i + 8, 3).Value
            .Bookmarks("Bookmark_11").Range.Text = Cells(i + 9, 3).Value
            .Bookmarks("Bookmark_12").Range.Text = Cells(i + 10, 3).Value
            .Bookmarks("Bookmark_13").Range.Text = Cells(i + 11, 3).Value
            .Bookmarks("Bookmark_14").Range.Text = Cells(i + 12, 3).Value
            .Bookmarks("Bookmark_15").Range.Text = Cells(i + 13, 3).Value
            .Bookmarks("Bookmark_16").Range.Text = Cells(i + 14, 3).Value
            .Bookmarks("Bookmark_17").Range.Text = Cells(i + 15, 3).Value
        End With

Перейти

Посчитать выполнение одновременно двух условий

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

18.02.2025 19:42:26

Добрый день
как сделать, чтобы формула считала выполнение 2 условий одновременно.
Первое считает количество пустых ячеек в диапазоне и второе условие количество удовлетворяющее диапазону и значению в ячейке.
Я написал формулу, но она не работает =СЧЁТЕСЛИМН('2H2024'!E:E;Свод!B2;'2H2024'!S:V;"")
В чем может быть ошибка?
Спасибо

Перейти

Не переносится жирность текста при переносе в Word

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

10.02.2025 10:44:23

Добрый день

Есть макрос. Но при работе с Word жирность текста не переносится.
Что нужно сделать, чтобы полностью формат ячеек (жирность) переносилось в Ворд

Код

   ' Очистка содержимого
    Range("C2:C" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
    
    

   [C2].Resize(Cells(Rows.Count, "A").End(xlUp).Row - 1, 1).FormulaR1C1 = _
        "=RC[-2]&CHAR(10)&REPLACE(RC[-1],1,IFERROR(FIND("" ул."",RC[-1]),IFERROR(FIND("" пр-кт"",RC[-1]),IFERROR(FIND("" б-р"",RC[-1]),IFERROR(FIND("" пер"",RC[-1]),IFERROR(FIND("" наб."",RC[-1]),1))))),"""")&CHAR(10)&REPLACE(LEFT(RC[-1],FIND("","",RC[-1])-1),1,7,)&CHAR(10)&LEFT(RC[-1],6)"
        
        
   ' Преобразование формулы в значения
    With Range("C2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Value = .Value
    End With

    ' Делаем ФИО жирным в столбце C.
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        searchString = ThisWorkbook.Sheets(1).Cells(i, 1).Value  ' ФИО из столбца А

        'Определяем позицию начала ФИО в ячейке С
        Dim startPos As Long
        startPos = InStr(1, ThisWorkbook.Sheets(1).Cells(i, 3).Value, searchString)

        'Если ФИО обнаружено в ячейке С
        If startPos > 0 Then
            With ThisWorkbook.Sheets(1).Cells(i, 3).Characters(startPos, Len(searchString)).Font
                .Bold = True
            End With
        End If
    Next i


    MsgBox "Обработка завершена."

        
        
    MsgBox ("Это снова я - твой помощник и мы продолжаем" & vbCrLf & "Сейчас Вас система попросит выбрать файл Word, где хранится шаблон наклеек")





    ' Диалоговое окно для выбора файла шаблона Word
    Dim wordFilePath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Выберите файл шаблона Word"
        .Filters.Clear
        .Filters.Add "Word Documents", "*.doc"
        .AllowMultiSelect = False
        If .Show = -1 Then
            wordFilePath = .SelectedItems(1)
        Else
            MsgBox "Файл не выбран. Макрос завершен."
            Exit Sub
        End If
    End With

    On Error Resume Next
    Dim objWrdApp As Object
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0 ' Включить стандартную обработку ошибок обратно

    objWrdApp.Visible = True
    Dim objWrdDoc As Object
    Set objWrdDoc = objWrdApp.Documents.Open(wordFilePath)


    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    l = l + 1
        ' Обновление закладок в Word данными из Excel
        With objWrdDoc
            .Bookmarks("Bookmark_2").Range.Text = Cells(i, 3).Value
            .Bookmarks("Bookmark_3").Range.Text = Cells(i + 1, 3).Value
            .Bookmarks("Bookmark_4").Range.Text = Cells(i + 2, 3).Value
            .Bookmarks("Bookmark_5").Range.Text = Cells(i + 3, 3).Value
            .Bookmarks("Bookmark_6").Range.Text = Cells(i + 4, 3).Value
            .Bookmarks("Bookmark_7").Range.Text = Cells(i + 5, 3).Value
            .Bookmarks("Bookmark_8").Range.Text = Cells(i + 6, 3).Value

            .Bookmarks("Bookmark_9").Range.Text = Cells(i + 7, 3).Value
            .Bookmarks("Bookmark_10").Range.Text = Cells(i + 8, 3).Value
            .Bookmarks("Bookmark_11").Range.Text = Cells(i + 9, 3).Value
            .Bookmarks("Bookmark_12").Range.Text = Cells(i + 10, 3).Value
            .Bookmarks("Bookmark_13").Range.Text = Cells(i + 11, 3).Value
            .Bookmarks("Bookmark_14").Range.Text = Cells(i + 12, 3).Value
            .Bookmarks("Bookmark_15").Range.Text = Cells(i + 13, 3).Value
            .Bookmarks("Bookmark_16").Range.Text = Cells(i + 14, 3).Value
            .Bookmarks("Bookmark_17").Range.Text = Cells(i + 15, 3).Value
        End With

Перейти

Не сохраняется документ Word при вызове из Excel VBA

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

22.12.2024 19:21:06

Добрый день
Есть макрос, почему Word не реагирует и не сохраняет файл Doc2?

Код

    Dim objWrdApp As Object
    Dim objWrdDoc As Object
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
            Set objWrdDoc = objWrdApp.Documents.Open("C:\Users\Homecomputer\Desktop\Макрос\Doc1.docx")
            objWrdApp.Visible = True
        End If
    Set objWrdDoc = objWrdApp.Documents.Open("C:\Users\Homecomputer\Desktop\Макрос\Doc1.docx")
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    objWrdDoc.SaveAs "C:\Users\Homecomputer\Desktop\Макрос\Doc2.docx"

Изменено: Jenya1980 - 22.12.2024 19:21:29

Перейти

Выполнять условия в цикле при каждом кратном значении

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

22.12.2024 13:16:43

Добрый день
Есть цикл от 1 до 1000
Как сделать, чтобы при каждом значении равном X выполнялось условие.
Я так понимаю, что переменную в цикле делим на X и должно быть число без остатка.
Как это можно оформить в цикле?
Спасибо

Перейти

Загрузить из Excel в Word данные их ячеек

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 22.12.2024 09:29:06 Добрый день Посоветуйте как сделать Есть таблица со списком ФИО и адресов в Эксель, нужно переделать в формат для почты России в вордовский вариант правильно разложив адрес Какие варианты есть? спасибо
	Перейти

Рассчитать продажи с первого дня открытия магазина

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

18.07.2024 14:16:11

Добрый день.
Есть список магазинов с продажами по дням (выделено желтым)
Первый непустой столбец - открытие магазина.
Необходимо обработать таблицу так, чтобы сопоставить по дням количество продаж с момента открытия

Какие варианты могут мне помочь.
Помогите, пожалуйста

Перейти

Отправить письмо по списку с логинами и паролями

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 15.04.2024 12:06:28 Добрый день. В столбце A содержится информация о логинах В столбце B пароль В столбце С - адрес E-mail Как сделать, чтобы разослать всему списку логины и пароли вставляя в текст письма?
	Перейти

Макрос сохранения картинок из ссылок в папку

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

21.01.2024 22:01:44

Добрый день
Подскажите как лучше сделать.
Нужно создать папку с именем из столбца 1(А) и сохранить в нее все картинки, которые находятся по ссылкам из ячеек

более 100 строк в файле
Пример во вложении

Буду признателен за любую помощь

Спасибо.

Перейти

В ячейке отобразить фотографию из ссылки

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 10.07.2023 21:33:42 Добрый день. Нужна консультация. Есть 100 ячеек (A1:A100) в которых указаны url ссылки на картинки Как сделать, чтобы в каждой ячейке вместо url появилась картинка из ссылки? Спасибо
	Перейти

Найти значение диапазоне ячеек

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

06.03.2023 09:36:28

Добрый день.
Есть таблица с данными расписания.
Если в строке диапазона есть хотя бы одно число 13, то необходимо поставить 1
Если нет, то 0

09:00-18:00	09:00-13:00	09:00-18:00	1
09:00-18:00	10:00-14:00	09:00-18:00	0

Можно это сделать без макроса?

Перейти

Отрицательное время

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

19.02.2023 23:31:12

Добрый день
Как в Эксель показать в ячейке отрицательное время (формат время)?
Делая разницу между ячейками, если положительное число, то все ок, а если отрицательное, то ####
Как показать отрицательное время?

Спасибо

Перейти

Посчитать количество рабочих часов

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 17.02.2023 13:49:07 Добрый день. В ячейке указано рабочее время (например, "10:00-13:00; 14:00-18:00"). Как можно рассчитать общее количество часов? Т.е. в данном примере должно быть 7 часов Спасибо.
	Перейти

Оптимизировать код удаления строк VBA по фильтру

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

18.07.2022 21:16:15

Добрый день
Написал код, который перебирает строки и при наличии в ячейки значения "апельсины" - удаляет сроку
Все работает, но очень медленно, так как строк более 500 тыс.
Подскажите, пожалуйста, можно как-то ускорить быстродействие и применить другой код?

Код
iStrok = Sheets("1").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To iStrok If Sheets("Отчет").Cells(i, 3) = "Апельсины" Then Rows(i).Delete i = i - 1 End If Next i

Перейти

Зафиксировать сведения о пользователе

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

07.06.2022 17:19:28

Добрый день.
Умею через VBA фиксировать имя компьютера, пользователя, но никак не могу найти команду, которая позволяла бы выводить "сведения о пользователе"

Подскажите, пожалуйста, как можно фиксировать учетную запись пользователя?

Спасибо.

Перейти

Отображение Имя пользователя в объекте PowerPoint

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

01.06.2022 22:13:21

Добрый день.
Есть слайд в PowerPoint. Подскажите, пожалуйста, как на слайде сделать так, чтобы при открытии презентации система на слайде отображала имя пользователя?

В интернете не мог найти, может кто знает здесь(понимаю, что не тема excel)

Изменено: Юрий М - 02.06.2022 14:39:43

Перейти

Посчитать значения, исключая время в дате

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

12.05.2022 22:50:10

Добрый день
Есть в таблицы в которых есть дата и во второй дата и время
Нужно посчитать количество, удовлетворяющие условию по дате (счетеслимн)
Но вот как исключить время при использовании функции не совсем могу понять
Помогите, пожалуйста
Пример во вложении

Перейти

Использование "Счетеслимн" и дата

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

19.04.2022 17:58:14

Добрый день
есть две таблицы
в одной формат даты 05.01.2022 17:16:29
в другой формат даты 05.01.2022

Как мне использовать формулу счетеслимн, чтобы использовать в качестве диапазона столбца - 05.01.2022 17:16:29
а условие по дате 05.01.2022

Перейти

Как используя функцию ТЕКСТ получить дату в формате: "19" октябрь 2021 года

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 29.10.2021 20:38:52 Добрый день Подскажите, пожалуйста, как используя функцию ТЕКСТ получить дату в формате: "19" октябрь 2021 года То есть дату взять в кавычки Спасибо Изменено: vikttur - 29.10.2021 20:40:06
	Перейти

Сохранить файл Word макросом из VBA

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

06.10.2021 10:46:05

Добрый день
Подскажите, пожалуйста, а где ошибка в макросе VBA
Мне нужно сохранить из VBA открытый файл WORD с именем ячейки 2,2

Код
appWD.SaveAs2 (ThisWorkbook.Path & "\" & Cells(2, 2) & ".docx")

Возникает ошибка(
что может быть не так?

Перейти

Определить, нужно ли отгружать товар в магазины

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

02.10.2021 15:23:05

Добрый день
Помогите решить задачу (без VBA)

Есть 2 таблицы.
Одна со списком магазинов (заказ от магазина)
Вторая таблица, что разрешено для отгрузки в данный магазин (4 типа товаров)

Как формулой поставить в столбец C, чтобы определить статус "Разрешено" или "не разрешено" отгрузка.

Спасибо.

Изменено: vikttur - 03.10.2021 11:20:11

Перейти

Функция ТЕКСТ и дата в родительном падеже

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

12.09.2021 07:38:49

Добрый день
Есть задачка указывания информации в документах с датами. К примеру счет от 1 августа 2021 г
Использование ТЕКСТ позволяет сделать счет от 1 август 2021 г (то есть не хватает "а")

Как обучить excel писать по-русски)

P.S. желательно без макросов

Изменено: Jenya1980 - 12.09.2021 07:39:14

Перейти

Скрытие или исключение значений в сводной таблице

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

19.07.2021 12:55:45

Добрый день
Как можно сделать, чтобы итоговые значения в сводной таблице остались, а значений в столбцах не было?

В интернете не нашел информации.
Сводная таблица большая и вариант разового скрытия столбцов не подойдет (как обычная таблица)

Спасибо

Перейти

Добавить формулу в сводную таблицу

Jenya1980 Пользователь Сообщений: 292 Регистрация: 15.05.2013	# 19.07.2021 06:15:53 Добрый день Есть сводная таблица. Как в сводную таблицу добавить формулу, чтобы рассчитывала показатели (столбец М) Не удобно писать формулу вручную и переписывать заново при изменении Спасибо
	Перейти

Загрузить прайс-лист в Эксель из XML

Jenya1980

Пользователь

Сообщений: 292 Регистрация: 15.05.2013

08.04.2021 22:04:17

Добрый день
В первый раз встречаю ситуацию, когда не могу загрузить в Эксель прайс-лист с сайта
http://6443780.ru/xml/suvenirow_compact.xml
Возникает код ошибки 1072896636
Прочитал в интернете, что с самим файлом можно решить вопрос, но как можно загрузить из интернета без правки xml?

Спасибо

Перейти