Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Jenya1980
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 След.
Разница между датами с учетом рабочего дня
 
#
21.07.2025 11:11:19
Обед 1 час (13-14)
У меня с компа доходит до 90% и все останавливается.
Файл весит 100кб
 
Перейти    
Разница между датами с учетом рабочего дня
 
#
21.07.2025 11:08:55
Никак не вставляется файл
Вот пример
Дата   созданияДата закрытияКоличество   часов:минут между датами в рабочих часах с (9:00-18:00
18.07.2025   23:2618.07.2025   23:260
18.07.2025   23:1921.07.2025   08:470
18.07.2025   23:0918.07.2025   23:090
18.07.2025   22:2318.07.2025   22:230
18.07.2025   20:0019.07.2025   15:027:02
18.07.2025   16:3720.07.2025   13:5912:59
Изменено: Jenya1980 - 21.07.2025 11:09:44
 
Перейти    
Разница между датами с учетом рабочего дня
 
#
21.07.2025 10:42:26
файл не могу прикрепить( до 90% доходит и откоючается.
8 часов, потому что нужно считать только рабочие часы (сколько времени попало в этот интервал с 09:00-18:00)
В примере 8 часов как раз. 1 рабочий день
 
Перейти    
Разница между датами с учетом рабочего дня
 
#
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:2618.07.2025 23:26
Изменено: Jenya1980 - 21.07.2025 11:05:36
 
Перейти    
Объединение таблиц с учетом дат
 
#
30.05.2025 15:35:16
Добрый день
Есть 100 листов с одинаковым форматом таблицы на каждом, но с разным количеством дней.
Как объединить таблицы в одну, при этом вставлять в итоговую учитывая даты каждой таблицы.
То есть вставлять данные в итоговую с учетом столбца даты
Очень нужна помощь
 
Перейти    
Как из группированной таблицы сделать таблицу, чтобы можно делать сводную
 
#
27.03.2025 06:32:51
Исправил, но у меня возникает ошибка в строке

ReDim currentHeaderValues(1 To groupLevel)
Код
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
  Dim lastColumn As Integer

  ' Укажите лист, содержащий сгруппированные данные
  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) = 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

  ' Пройдитесь по каждой строке исходных данных
  Dim currentGroup(1 To 5) As String ' Массив для хранения значений группировок
  Dim groupIndex As Integer

  For i = 1 To lastRow

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

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

      ' Записываем значение в нужную колонку
      outputSheet.Cells(outputRow, currentLevel).Value = ws.Cells(i, 1).Value

      ' Заполняем пустые ячейки справа пробелами
      lastColumn = 5 ' Указываем номер последней колонки
      For j = currentLevel + 1 To lastColumn
        outputSheet.Cells(outputRow, j).Value = ""
      Next j

      ' Если уровень отступа = 0, то это новая строка
      If currentLevel = 1 Then
          outputRow = outputRow + 1
      End If
    End If

  Next i

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

End Sub
 
Перейти    
Как из группированной таблицы сделать таблицу, чтобы можно делать сводную
 
#
26.03.2025 23:08:02
Почти)
Я бы хотел, чтобы таблица была следующего формата
1   группировка2 группировка3 группировка4 группировка5 группировка
ДВФМагазин0
ДВФМагазин1
ДВФМагазин2
ДВФМагазин3
ДВФМагазин4
ДВФМагазин5
МоскваМагазин6
МоскваМагазин7
МоскваМагазин8
ЦРФМагазин7
ЦРФМагазин8
ЦРФМагазин9
ЦРФМагазин10
ЦРФМагазин11
ЦРФМагазин12
ЦРФМагазин13
ЦРФМагазин14
 
Перейти    
Как из группированной таблицы сделать таблицу, чтобы можно делать сводную
 
#
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 перенести в Ворд с сохранение формата жирности текст
 
#
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
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
19.02.2025 14:42:33
Отлично. А еще помогите, пожалуйста, почему формула =СУММЕСЛИ('2H2024'!E:E;Свод!B2;'2H2024'!S:V) не работает. не корректно суммирует
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
19.02.2025 12:02:13
Отлично. Супер. а как посчитать количество непустых?
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
19.02.2025 10:14:42
Приложил
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
19.02.2025 09:58:44
Цитата
написал:
=СУМПРОИЗВ(('2H2024'!E1:E1000=Свод!B2)*('2H2024'!S1:V1000=""))
все равно ошибка вощникает
Может потому что в ячейках E1:E1000 и Свод!B2 там буквы?
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
18.02.2025 19:53:43
А при таком варианте всегда 0 получается
=СЧЁТЕСЛИМН('2H2024'!E:E;Свод!B7;'2H2024'!S:S;"";'2H2024'!T:T;"";'2H2024'!U:U;"";'2H2024'!V:V;"")
 
Перейти    
Посчитать выполнение одновременно двух условий
 
#
18.02.2025 19:42:26
Добрый день
как сделать, чтобы формула считала выполнение 2 условий одновременно.
Первое считает количество пустых ячеек в диапазоне и второе условие количество удовлетворяющее диапазону и значению в ячейке.
Я написал формулу, но она не работает  =СЧЁТЕСЛИМН('2H2024'!E:E;Свод!B2;'2H2024'!S:V;"")
В чем может быть ошибка?
Спасибо
 
Перейти    
Не переносится жирность текста при переносе в Word
 
#
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
 
#
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
 
Перейти    
Выполнять условия в цикле при каждом кратном значении
 
#
22.12.2024 13:16:43
Добрый день
Есть цикл от 1 до 1000
Как сделать, чтобы при каждом значении равном X выполнялось условие.
Я так понимаю, что переменную в цикле делим на X и должно быть число без остатка.
Как это можно оформить в цикле?
Спасибо
 
Перейти    
Загрузить из Excel в Word данные их ячеек
 
#
22.12.2024 11:50:11
спасибо, поищу. Важное замечание
Я пытаюсь первый вариант в макрос перевести
Код
[C2].Resize(Cells(Rows.Count, "A").End(xlUp).Row - 1, 1).FormulaR1C1 = "=A1&CHAR(10)&REPLACE(B1;1;FIND("" улица"";B1)&CHAR(10)&REPLACE(LEFT(B1;FIND("","";B1)-1);1;7;)&CHAR(10)&LEFT(B1;6)"
что не так в этой строке, выдается ошибка
 
Перейти    
Загрузить из Excel в Word данные их ячеек
 
#
22.12.2024 09:59:10
Класс! Спасибо большое!
А Макросом можно из excel в word переносить?
 
Перейти    
Загрузить из Excel в Word данные их ячеек
 
#
22.12.2024 09:29:06
Добрый день
Посоветуйте как сделать
Есть таблица со списком ФИО и адресов в Эксель, нужно переделать в формат для почты России в вордовский вариант правильно разложив адрес

Какие варианты есть?
спасибо  
 
Перейти    
Рассчитать продажи с первого дня открытия магазина
 
#
18.07.2024 14:16:11
Добрый день.
Есть список магазинов с продажами по дням (выделено желтым)
Первый непустой столбец - открытие магазина.
Необходимо обработать таблицу так, чтобы сопоставить по дням количество продаж с момента открытия

Какие варианты могут мне помочь.
Помогите, пожалуйста
 
Перейти    
Отправить письмо по списку с логинами и паролями
 
#
15.04.2024 12:06:28
Добрый день.
В столбце A содержится информация о логинах
В столбце B пароль
В столбце С - адрес E-mail
Как сделать, чтобы разослать всему списку логины и пароли вставляя в текст письма?
 
Перейти    
Макрос сохранения картинок из ссылок в папку
 
#
22.01.2024 09:46:59
excel ругается, что нет такой функции(
URLDownloadToFile
 
Перейти    
Макрос сохранения картинок из ссылок в папку
 
#
21.01.2024 22:01:44
Добрый день
Подскажите как лучше сделать.
Нужно создать папку с именем из столбца 1(А) и сохранить в нее все картинки, которые находятся по ссылкам из ячеек

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

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

Спасибо.
 
Перейти    
Выпадающий список с возможностью поиска внутри списка
 
#
20.09.2023 12:41:51
С предыдущим вопросом разобрался.
А как вывести изначально весь список в выпадающем меню?
Чтобы началась фильтрация только после начала ввода букв
 
Перейти    
Выпадающий список с возможностью поиска внутри списка
 
#
19.09.2023 11:11:03
Добрый день.
Отличный вариант. Но не работает, когда я распространяю на несколько столбцов.
Подскажите, пожалуйста как сделать на несколько столбцов выпадающий список (в примере выше только на один)
Я так делал для двух столбцов
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("O2:O113000")) Is Nothing Then
        If Target.Value <> "" Then: Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
        bu = True
        With Me.TextBox1
            .Top = Target.Top
            .Left = Target.Left
            .Height = Target.Height
            .Width = Target.Width
            .Text = Target.Value
            .Activate
        End With
        With Me.ListBox1
            .Top = Target.Top
            .Left = Target.Left + Target.Width
            .Clear
        End With
        bu = False
        Me.TextBox1.Visible = True
        Me.ListBox1.Visible = True
    Else
        Me.TextBox1.Visible = False
        Me.ListBox1.Visible = False
    End If
    
    
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("P2:P113000")) Is Nothing Then
        If Target.Value <> "" Then: Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
        bu = True
        With Me.TextBox1
            .Top = Target.Top
            .Left = Target.Left
            .Height = Target.Height
            .Width = Target.Width
            .Text = Target.Value
            .Activate
        End With
        With Me.ListBox1
            .Top = Target.Top
            .Left = Target.Left + Target.Width
            .Clear
        End With
        bu = False
        Me.TextBox1.Visible = True
        Me.ListBox1.Visible = True
    Else
        Me.TextBox1.Visible = False
        Me.ListBox1.Visible = False
    End If
Изменено: Jenya1980 - 19.09.2023 13:34:13
 
Перейти    
В ячейке отобразить фотографию из ссылки
 
#
10.07.2023 21:33:42
Добрый день.
Нужна консультация. Есть 100 ячеек (A1:A100) в которых указаны url ссылки на картинки
Как сделать, чтобы в каждой ячейке вместо url появилась картинка из ссылки?

Спасибо
 
Перейти    
Найти значение диапазоне ячеек
 
#
06.03.2023 09:36:28
Добрый день.
Есть таблица с данными расписания.
Если в строке диапазона есть хотя бы одно число 13, то необходимо поставить 1
Если нет, то 0
09:00-18:0009:00-13:0009:00-18:001
09:00-18:0010:00-14:0009:00-18:000
Можно это сделать без макроса?
 
Перейти    
Отрицательное время
 
#
19.02.2023 23:31:12
Добрый день
Как в Эксель показать в ячейке отрицательное время (формат время)?
Делая разницу между ячейками, если положительное число, то все ок, а если отрицательное, то ####
Как показать отрицательное время?

Спасибо
 
Перейти    
Страницы: 1 2 3 4 5 6 7 8 9 10 След.
Наверх