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

Страницы: 1
В сводной не показывает общий итог по строке
 
Если вдруг кто-то случайно наткнулся также как и я, то есть еще такой вариант. Кликаем на сводную таблицу – Параметры – Поля, элементы и наборы – Вычисляемое поле. Там в формулу добавляем те столбцы, которые хотите суммировать и между ними ставим +. Готово) В целом в это поле можно и любую другую формулу вписать.
Автоматически вставляется символ ' (одиночные кавычки) при вставке завтрашней даты через VBA, Есть макрос который вставляет сегодняшнюю дату
 
Огромное спасибо! Перенос кода на новый лист помог!
Не совсем понимаю что сподвигает эксель так делать, но теперь все работает.
Изменено: Иван Копенков - 16.09.2022 09:59:08
Автоматически вставляется символ ' (одиночные кавычки) при вставке завтрашней даты через VBA, Есть макрос который вставляет сегодняшнюю дату
 
Есть макрос который вставляет сегодняшнюю дату в одну ячейку и завтрашнюю дату в другую при помощи следующего макроса

Код
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1             
Worksheets("Лист1").Range("C" & LastRow) = Format(Now, "General Date")
Worksheets("Лист1").Range("D" & LastRow) = Format(Now + 1, "General Date")
Сегодняшняя даты вставляется без проблем, но завтрашняя дата отображается в виде '17.09.2022 11:04:25
Таким образом к этой ячейке невозможно применять условие если.
Есть ли варианты как по другому записать дату с интервалом +1 день или убрать символ после вставки?

З.Ы. Пробовал при помощи
Код
Worksheets("Лист1").Range("D2") = Right(Worksheets("Лист1").Range("D2"), Len(Worksheets("Лист1").Range("D2")) - 1)
Но тогда убирается цифра из даты, а не сам симовол.
Также пробовал через
Код
Replace What:="'", Replacement:=""  
Replace What:="~'", Replacement:=""
Но это также не помогло...
Не вставляется большой объем данных из буфера обмена в файл .txt
 
Всем спасибо, проблему решил.
Изменил метод записи и все заработало с любыми таблицами и символами.
Код
Private Sub TableHtml()
    ' макрос для экспорта выделенного диапазона ячеек в HTML
    On Error Resume Next
'    'Прячем ненужные ячейки если необходимо
'    Range("G:H").EntireColumn.Hidden = True




'На случай выделения несвязанных диапазонов
Selection.Areas(1).Select

'Обозначаем строки и колонки
    iFirstLine = Selection.Row
    iFirstCol = Selection.Column
    iLastLine = iFirstLine + Selection.Rows.Count - 1
    iLastCol = iFirstCol + Selection.Columns.Count - 1



    'HTML классы для таблицы и четного ряда данных
    sTableClass = "ExcelTable"
    sOddRowClass = "odd"

    sOutput = "<div><table class='" & sTableClass & "' border=1 width=100% align=center>"    ' Начинаем таблицу
    'sOutput = sOutput & "<caption>" & Cells(iFirstLine, iFirstCol).Text & "</caption>"

    For k = iFirstLine To iLastLine    ' Обрабатываем Excel таблицу
        If (k \ 2 <> k / 2) Then    'проверяем на четность
            sLine = "<tr class ='" & sOddRowClass & "'>"
        Else
            sLine = "<tr>"
        End If

        iCountColspan = 0    'счетчик объединенных ячеек
        For j = iFirstCol To iLastCol
            'Проверяем, не объединена ли эта ячейка с соседними.
            If Cells(k, j).MergeCells = True Then
                'Получаем число объединенных ячеек
                iCountColspan = Cells(k, j).MergeArea.Count
            Else
                iCountColspan = 0
            End If
            Set oCurrentCell = ActiveSheet.Cells(k, j)
            sLine = sLine & "<td"

            'Проверяем, нужно ли вставлять код объединения ячейки с соседними
            If iCountColspan > 1 Then
                sLine = sLine & " colspan=" & iCountColspan
                j = j + iCountColspan - 1    'пропускаем ячейки
                iCountColspan = 0
            End If

            'Если по центру
            If oCurrentCell.HorizontalAlignment = -4108 Then sLine = sLine & " style='text-align: center;'"
            sLine = sLine & ">"

            'Если пусто, прописываем  
            If oCurrentCell.Text <> "" Then sValue = oCurrentCell.Text Else sValue = " "
            
            'Если жирный
            If oCurrentCell.Font.Bold = True Then sValue = "<b>" & sValue & "</b>"
            
            'Если курсив
            If oCurrentCell.Font.Italic = True Then sValue = "<i>" & sValue & "</i>"

            sLine = sLine & sValue & "</td>"
            If k = iFirstLine Then sLine = Replace(sLine, "<td", "<th")

        Next j
        sOutput = sOutput & sLine & "</tr>"
    Next k

    sOutput = sOutput & "</table></div> <style>& ""table{width: 100%; border-collapse: collapse;}td{border: 1px solid;border-collapse:collapse;}</style>"  'Заканчиваем таблицу

'Удаляем прошлую версию файла
 Kill "G:\Лист1.html"

'записываем результат в файл .txt
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile("G:\Лист1.txt", True, True)
    Fileout.Write (sOutput)
    Fileout.Close

'Из файла .txt делаем .html
Name "G:\Лист1.txt" As "G:\Лист1.html"



'Открываем хтмльку, если необходимо
CreateObject("wscript.shell").Run "explorer.exe /e,/open,""" & "G:\Лист1.html"

End Sub
Не вставляется большой объем данных из буфера обмена в файл .txt
 
Спасибо, такой вариант кода работает. Он подошел бы, но он сохраняет пропорции и съедает текст, а нужен весь текст из ячейки некоторые из которых содержат по несколько тысяч символов.

А также в файл файл закидывается много мусора, что мне не нужно. Идеальный результатом бы был файл как в коде который был изначально.
При удалении некоторых символов по типу "\" и "/"  стало работать с некоторыми таблицами.
Пытался также убрать непечатные символы, но не помогло. Некоторые таблицы все также выдаются пустыми.
Пробовал с бОльшими таблицами, но из другого файла и все работает.
Проблема видимо не в недостатке памяти в буфере обмена и не в недостатке линии в текстовом файле, а в недопустимых символах в ячейках.
Буду думать...
Изменено: Иван Копенков - 07.08.2022 17:40:49
Не вставляется большой объем данных из буфера обмена в файл .txt
 
RAN, поправка резонная. Попробовал - результат такой же :(Увидел что в некоторых строках есть непечатные символы и вещи по типу “&ndash;”.
Попробую их убрать и вернусь с результатом
Не вставляется большой объем данных из буфера обмена в файл .txt
 
Behruz, к сожалению опять выводит пустой файл. Я бы с удовольствием поделился файлом, но там много коммерческих моментов.
В таблице есть ячейки с максимальным количеством символов в ней. Возможно проблема в этом?
Позже попробую отправить файл с большой таблицей.  
Не вставляется большой объем данных из буфера обмена в файл .txt
 
Доброго времени суток. Есть макрос который делает из выделенной таблицы в эксель таблицу в формале HTML.
Код работает прекрасно, но если таблица содержит большое количество строк (около 1500), то текст копируется в буфер обмена, но не вставляется в файл.
Код прилагаю.
Код
Private Sub CommandButton1_Click()
    ' макрос для экспорта выделенного диапазона ячеек в HTML
    On Error Resume Next


    Selection.Areas(1).Select    ' на случай выделения несвязанных диапазонов

    iFirstLine = Selection.Row
    iFirstCol = Selection.Column
    iLastLine = iFirstLine + Selection.Rows.Count - 1
    iLastCol = iFirstCol + Selection.Columns.Count - 1


    'HTML классы для таблицы и четного ряда данных
    sTableClass = "ExcelTable"
    sOddRowClass = "odd"

    sOutput = "<div><table class='" & sTableClass & "' border=1 width=100% align=center>"    ' Начинаем таблицу
    'sOutput = sOutput & "<caption>" & Cells(iFirstLine, iFirstCol).Text & "</caption>"

    For k = iFirstLine To iLastLine    ' Обрабатываем Excel таблицу
        If (k \ 2 <> k / 2) Then    'проверяем на четность
            sLine = "<tr class ='" & sOddRowClass & "'>"
        Else
            sLine = "<tr>"
        End If

        iCountColspan = 0    'счетчик объединенных ячеек
        For j = iFirstCol To iLastCol
            'Проверяем, не объединена ли эта ячейка с соседними.
            If Cells(k, j).MergeCells = True Then
                'Получаем число объединенных ячеек
                iCountColspan = Cells(k, j).MergeArea.Count
            Else
                iCountColspan = 0
            End If
            Set oCurrentCell = ActiveSheet.Cells(k, j)
            sLine = sLine & "<td"

            'Проверяем, нужно ли вставлять код объединения ячейки с соседними
            If iCountColspan > 1 Then
                sLine = sLine & " colspan=" & iCountColspan
                j = j + iCountColspan - 1    'пропускаем ячейки
                iCountColspan = 0
            End If

            'Если по центру
            If oCurrentCell.HorizontalAlignment = -4108 Then sLine = sLine & " style='text-align: center;'"
            sLine = sLine & ">"

            'Если пусто, прописываем  
            If oCurrentCell.Text <> "" Then sValue = oCurrentCell.Text Else sValue = " "
            'Если жирный
            If oCurrentCell.Font.Bold = True Then sValue = "<b>" & sValue & "</b>"
            'Если курсив
            If oCurrentCell.Font.Italic = True Then sValue = "<i>" & sValue & "</i>"

            sLine = sLine & sValue & "</td>"
            If k = iFirstLine Then sLine = Replace(sLine, "<td", "<th")

        Next j
        sOutput = sOutput & sLine & "</tr>"
    Next k

   'Заканчиваем таблицу
    sOutput = sOutput & "</table></div> <style>& ""table{width: 100%; border-collapse: collapse;}td{border: 1px solid;border-collapse:collapse;}</style>"  

    ' Копируем полученный HTML в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText sOutput: .PutInClipboard
    End With

  'записываем результат в файл .txt
  clipboard = CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
'удаляем прошлую версию файла

Kill "G:Лист1.html"

file = "G:\Лист1.txt"
 '8 - дозапись, True - создавать, если
Set ofile = CreateObject("Scripting.FileSystemObject").OpenTextFile(file, 8, True)
'Вписываем из буфера обмена
ofile.WriteLine (clipboard)
ofile.Close

WScript.Echo "OK"

'Из файла .txt делаем .html

Name "G:\Лист1.txt" As "G:\Лист1.html"
Если убрать пункт "On Error Resume Next" ошибка будет выдаваться на строке "ofile.WriteLine (clipboard)"
После ошибки результат остается в буфере обмена и я могу вручную вставить его в файл, но хотелось бы сделать это в автоматическом режиме.

Есть ли другие способы вставлять текст в текстовый файл из буфера обмена? Или способ исправления ошибки?
Изменено: Иван Копенков - 06.08.2022 12:39:08
Страницы: 1
Наверх