Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 127 След.
Подсветка диапазона желтым цветом
 
Рад, что помог, всего доброго!
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
И для ускорения кода лучше использовать перебор значений массива, а не ячеек:
Код
Sub CommandButton2_Click()
  Dim a()
  For n = 1 To 99 * m
    With Range(Cells(n, 1), Cells(n + m - 1, m))
      cn = 0
      a() = .Value
      For i = 1 To m
        For j = 1 To m
          cn = cn + Abs(a(i, j) = 1)
          If cn >= 6 Then
            'Debug.Print .Address
            .BorderAround xlContinuous, xlMedium
            .SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .BorderAround
            n = n + m - 1
            Exit For
          End If
        Next
      Next
    End With
  Next
End Sub
Изменено: ZVI - 20 Янв 2018 11:42:08
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Если нужна сетка внутри, то такой вариант:
Код
Sub CommandButton2_Click()
  For n = 1 To 99 * m
    With Range(Cells(n, 1), Cells(n + m - 1, m))
      cn = 0
      For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
          cn = cn + Abs(.Cells(i, j).Value = 1)
          If cn >= 6 Then
            Debug.Print .Address
            .BorderAround xlContinuous, xlMedium
            .SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .BorderAround
            n = n + m - 1
            Exit For
          End If
        Next
      Next
    End With
  Next
End Sub
Изменено: ZVI - 20 Янв 2018 11:25:31
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Посмотрите код в сообщении #6, я его немного подправил, убрав сетку (xlNone) для внутренних ячеек найденных фрагментах
Изменено: ZVI - 20 Янв 2018 11:13:12
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Не разбираясь в алгоритме Ваш код может быть таким:
Код
Sub CommandButton2_Click()
  For n = 1 To 99 * m
    With Range(Cells(n, 1), Cells(n + m - 1, m))
      cn = 0
      For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
          cn = cn + Abs(.Cells(i, j).Value = 1)
          If cn >= 6 Then
            'Debug.Print .Address
            .BorderAround xlContinuous
            .SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .BorderAround
            n = n + m - 1
            Exit For
          End If
        Next
      Next
    End With
  Next
End Sub
Изменено: ZVI - 20 Янв 2018 11:09:45
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Мой код относился к фрагменту, опубликованному Вами в сообщении  #1.
Опишите, пожалуйста, словами алгоритм выделения фрагментов.
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Этот код нарисует рамки вокруг диапазона [P15:R23], закрасит ячеки желтой заливкой и очистит внутренние линии, если они были:
Код
Sub Test()
  With Range("P15:R23")
    .BorderAround xlContinuous
    .Interior.Color = vbYellow
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
  End With
End Sub

Вместо xlNone можно записать xlContinuous, если нужны внутренние границыю
А чтобы оставить заливку ячеек с единицами, вместо .Interior.Color = vbYellow можно записать .SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
Изменено: ZVI - 20 Янв 2018 10:23:47
Vladimir Zakharov
Microsoft MVP – Excel
Подсветка диапазона желтым цветом
 
Для желтого цвета:  .Color = vbYellow
Vladimir Zakharov
Microsoft MVP – Excel
Разделить по ячейкам три числа, записанные в формате a/b (c%)
 
Если окажется, что дробь записана числом с форматом ячейки "Дробный", то можно так:
=--ЛЕВСИМВ(ТЕКСТ(A1;"#0/#0");НАЙТИ("/";ТЕКСТ(A1;"#0/#0"))-1)
=--ПСТР(ТЕКСТ(A1;"#0/#0");НАЙТИ("/";ТЕКСТ(A1;"#0/#0"))+1;15)

С приложенным примером гадать бы не пришлось, конечно.

С учетом приложенного примера тему лучше было бы назвать:
Как выделить числитель и знаменатель дроби из текста
Изменено: ZVI - 20 Янв 2018 11:38:26 (Изменено предлагаемое название темы)
Vladimir Zakharov
Microsoft MVP – Excel
Сложные, неоднотипные и комплексные вычисления в сводной, Разность промежуточных итогов, несколько итогов под разные вычисления и прочее
 
Цитата
StepanWolkoff написал: А так пример больше для того, чтобы показать путь решения желаемого результат с помощью PowerPivot и DAX.
Так и подумал. Пример хороший, спасибо! :)
Vladimir Zakharov
Microsoft MVP – Excel
Сложные, неоднотипные и комплексные вычисления в сводной, Разность промежуточных итогов, несколько итогов под разные вычисления и прочее
 
Приложил вариант формирования отчета макросом без PowerPivot с использованием штатных группировок строк, может это и устроит.
Макрос обновляет сводную таблицу, копирует ее на лист отчета, группирует строки, добавляет итоги и вписывает заказанные формулы.
Посмотрите, что там Ваши формулы насчитали, в коде в константе FM задается исходная формула, ее можно откорректировать.
Для формирования отчета на листе4 нужно нажать кнопку [Run].
Изменено: ZVI - 17 Янв 2018 08:00:53
Vladimir Zakharov
Microsoft MVP – Excel
Сложные, неоднотипные и комплексные вычисления в сводной, Разность промежуточных итогов, несколько итогов под разные вычисления и прочее
 
В примере сообщения #1 результат предложенной формулы
=ЕСЛИ(план>факт; план-факт; факт-план)
для строки "мясо" совпадает с приведенными на листе  [что нужно] значениями только для декабря:
Ожидается:| Мясо | -2145563.18 | -111410.62 | +16428373.18
ПоФормуле:| Мясо | +2145563.18| +111410.62| +16428373.18
Там везде план > факт, поэтому формула выдает положительные значения.
Соответственно и итоги будут отличаться.
В решении StepanWolkoff в строке "Общий итог №3" считается разность желтых ячеек, но в задании вроде бы требуется сумма.
Изменено: ZVI - 17 Янв 2018 06:45:54
Vladimir Zakharov
Microsoft MVP – Excel
Максим Зеленский - MVP !
 
Приятное известие! Максим, поздравляю! Давно пора! Удачи Вам в статусе MVP! :)
Vladimir Zakharov
Microsoft MVP – Excel
Добавить в денежный формат русские рубли (р. или руб.)
 
Цитата
Анжелика написал: у меня 7ка  и 10 excel
Анжелика тогда выделите эти ячейки - правый клик - формат ячеек - (все форматы) - в  поле Тип вместо квадратиков впишите р. и нажмите OK
Vladimir Zakharov
Microsoft MVP – Excel
Добавить в денежный формат русские рубли (р. или руб.)
 
Цитата
БМВ написал: Просто интересно, какую надо иметь систему
У меня квадратики на одной из операционных систем -  XP SP3. не обновлялась несколько лет
Vladimir Zakharov
Microsoft MVP – Excel
Добавить в денежный формат русские рубли (р. или руб.)
 
Это проблема из-за того, что на данном компьютере используются старые шрифты, а ячейки были отформатированы на компьютере с обновленными шрифтакми, в которых есть международный символ рубля. Выделите ячейки, в которых нужно исправить формат, на выделенном - правый клик - формат ячеек - денежный - число десятичных знаков выставить равным нулю, а обозначении выбрать р., выбрать для отрицательных чисел вариант с красным шрифтом -1 234р.  и нажать OK.
Изменено: ZVI - 18 Дек 2017 23:47:05
Vladimir Zakharov
Microsoft MVP – Excel
система office обнаружила проблему с этим файлом, Сегодня половину компьютеров не может открыть некоторые файлы.
 
Цитата
groN написал: ZVI, благодарю!
Хорошо, что до сих пор помогает :)
Похоже, что недавнее обновление Windows 10 снова установило принудительную проверку форматов файлов Excel не только для 2016-й версии, но и для 2010-й..
Есть жалобы на проблемы с загрузкой надстроек, защищенных  с помощью программы Unviewable+, которая форматы файлов как раз сознательно немного портит.
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Цитата
Focha написал: сделать форматирование через xml
Можно так: отформатировать вручную, а затем посмотреть, что выдает s = Selection.Value(xlRangeValueXMLSpreadsheet)
там в XML все очевидно. Останется только кодом создать подобный/измененный XML и записать его в ячейки обратно: Selection.Value(xlRangeValueXMLSpreadsheet) = s
Изменено: ZVI - 18 Дек 2017 15:59:21
Vladimir Zakharov
Microsoft MVP – Excel
данные из неоткрытого файла
 
Цитата
Karataev написал: СМЕЩ не работает с закрытыми файлами
Мое уточнение не про функцию СМЕЩ, которая не работает с закрытыми файлами, и даже не про функцию ИНДЕКС, которая работает, как Вы указали в #21, а всего лишь про "адрес становится абсолютным" для тех читателей темы, которые этого уточнения не знали.
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
В VBA справке про Value есть кратное описание параметров.
Аналогичная информация есть и в MSDN: Value, XlRangeValueDataType/
Машинный (неточный) перевод на русский: Value,  XlRangeValueDataType.
Примеров нет, но можно посмотреть результат под отладкой, например, в пошаговом режиме отладки посмотреть значение переменой s в коде сообщения #16
Изменено: ZVI - 18 Дек 2017 12:38:37
Vladimir Zakharov
Microsoft MVP – Excel
данные из неоткрытого файла
 
Цитата
Karataev написал: ... при закрытии файла, с которым работает файл, адрес становится абсолютным
Добрый вечер!
Уточню, что если файл, на ячейки которого ссылается формула, расположен в той же папке или в папках внутри, то Excel сохраняет относительные ссылки.
Это означает, что при копировании файлов в другое место с той же структурой папок, ссылки автоматически подстроятся.
Например, пусть обе книги Master.xlsx и Data.xlsx расположены в C:\Temp\1\ и в Master.xlsx использовалась такая формула:
='C:\Temp\1\[Data.xlsx]Лист1'!$B$2
Тогда, при переносе/копировании обоих файлов в D:\2\ формула в Excel автоматически станет такой:
='D:\2\[Data.xlsx]Лист1'!$B$2
Vladimir Zakharov
Microsoft MVP – Excel
VBA. Доступ к обьектам другого слайда., VBA PowerPoint
 
Пример кода в VBA-модуле Slide2:
Код
Option Explicit

Dim sum As Long

Private Sub CommandButton1_Click()
  
  ' Установка начального состояния
  sum = 0
  Slide2.CommandButton2.Enabled = True
  Set Slide1.Image2.Picture = Nothing
  Slide1.Label1.Caption = "Label1"
  Slide1.TextBox1.Value = ""

End Sub

Private Sub CommandButton2_Click()
  
  ' Изменить значение глобальной переменой
  sum = sum + 10

  ' Сделать неактивной кнопку на текущем слайде
  Me.CommandButton2.Enabled = False

  ' Отобразить слайд 1
  SlideShowWindows(1).View.GotoSlide 1

  ' Загрузить картинку в Image2 слайда 1 в зависимости от значения sum
  Select Case sum
    Case 10: Slide1.Image2.Picture = LoadPicture("C:\Сундук711.jpg")
    Case 20: Slide1.Image2.Picture = LoadPicture("C:\Сундук712.jpg")
    Case Else: Set Slide1.Image2.Picture = Nothing
  End Select

  ' Отобразить значение sum в Slide1.Label1 и Slide1.TextBox1
  Slide1.Label1.Caption = sum
  Slide1.TextBox1.Value = sum
  
End Sub
Vladimir Zakharov
Microsoft MVP – Excel
Передача текста из Excel в Word с сохранением форматирования текста
 
Цитата
Artem1977 написал: У меня копируется и вставляется как ячейка
С рамками и заливкой ячейки? Что выдает в Word-е  Debug.Print ActiveDocument.Tables.Count ? Приложите архив с примером того, что получилось и как нужно.
В любом случае, попробуйте сделать то, что предлагалось в сообщении #7.
Vladimir Zakharov
Microsoft MVP – Excel
Передача текста из Excel в Word с сохранением форматирования текста
 
Артем, копируется форматированный текст ячейки без самой ячейки (нет рамок и т.п.)
Вы попробуйте сначала добиться результата вручную, там много нюансов может оказаться.
Когда отрепетируете всё, то поступите так:
1. В Excel скопируйте то, что нужно
2. Перейдите в Word, включите там макрорекордер и выполните вставку и т.п.
3. Выключите макрорекордер Word-а и посмотрите, что он там записал.
4. При необходимости отредактируйте и отладьте код в Word-е
5. Перенесите код в Excel с учетом его переменных для Word.
Vladimir Zakharov
Microsoft MVP – Excel
Передача текста из Excel в Word с сохранением форматирования текста
 
Цитата
Artem1977 написал: Получается что вставляется ячейка, верно?
Нет, вставляется только форматированный текст. Проверяется в Worde так: Debug.Print ActiveDocument.Tables.Count
По поводу константы - она такая же в Word-е. Продублирована, так как Excel ничего не знает про константы Word-а, если не установлена принудительно ссылка на объектную модель Word через VBE-Tools-References.
Vladimir Zakharov
Microsoft MVP – Excel
Передача текста из Excel в Word с сохранением форматирования текста
 
Доброе утро! Попробуйте так:
Код
Sub Test()
  Const wdSingleCellText = 5
  Dim wd As Object
  Set wd = GetObject(, "Word.Application").ActiveDocument
  Sheets(1).Range("A1").Copy
  wd.Paragraphs(1).Range.PasteAndFormat wdSingleCellText
  Application.CutCopyMode = False
End Sub
Изменено: ZVI - 4 Дек 2017 09:30:41
Vladimir Zakharov
Microsoft MVP – Excel
Удаление дубликатов Collection vs. Dictionary
 
На всякий случай еще раз уточню, что так объединять имеет смысл, если обрабатывается один файл, как тот пример AB1_coll_dict_2017.xlsm с 600 000 строками.
Если же файлов данных несколько, то  сначала нужно обработать этим кодом и все остальные файлы.
При этом в TXT файлы будут дописаны новые уникальные фрагменты. Но строки дописанных фрагментов не будут автоматически уникальными с теми, что там уже были. Поэтому нужно полученные  TXT файлы перенести в другую папку и прогнать каждый из них через этот же код. И лишь после этого объединять новые TXT файлы в один. Всё это не займет много времени.
Vladimir Zakharov
Microsoft MVP – Excel
Удаление дубликатов Collection vs. Dictionary
 
Цитата
AB1 написал: благодарю за макрос.
Код из сообщения #54 быстрее словарей и коллекций, коллекции там использованы вместо массивов для упрощения кода. Тестовый файл с 600 000 строками, скачанный по ссылке из сообщения #51, на слабом компьютере обрабатывался за 20...30 секунд с формированием 169 текстовых файлов с уникальными данными.
Изменено: ZVI - 29 Ноя 2017 13:34:25
Vladimir Zakharov
Microsoft MVP – Excel
Удаление дубликатов Collection vs. Dictionary
 
Всем - привет!
VBA вполне годится для такой задачи. Все дело в алгоритме.
Код, приведенный ниже, из данных листа быстро создаст в папке ThisWorkbook.Path & "\OutFiles" текстовые файлы, в каждом из которых будут  уникальные строки одинаковой длины.
Кодом нужно обработать поочередно все  исходные данные, а затем данные из созданных  текстовых файлов (предварительно переместив эти файлы в другую папку). Результирующие текстовые файлы уникальных данных при желании можно объединить в один файл, но это уже несложно.
Затраты времени можно увидеть в окне Immediate при Const IsLog As Boolean = True

Код
Option Explicit
Option Compare Text

Sub CreateUniqDataFiles()
' ZVI:2017-11-28 http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&TID=98608
  
  Const IsLog As Boolean = True
  
  Dim a(), b(), v
  Dim FF As Integer
  Dim i As Long, j As Long
  Dim Rng As Range
  Dim s As String, f As String, p As String
  Dim t As Single, tt As Single
  
  Debug.Print "== Start " & Now
  tt = Timer
  p = ThisWorkbook.Path & "\OutFiles"
  Set Rng = ThisWorkbook.Sheets(1).UsedRange.Resize(, 2)
  With Rng
    ' Calc lengths
    t = Timer
    With .Columns(2)
      .Formula = "=LEN(A1)"
      .Value = .Value
      ReDim b(WorksheetFunction.Min(.Cells) To WorksheetFunction.Max(.Cells))
      .ClearContents
    End With
    If IsLog Then Debug.Print "Length", Round(Timer - t, 3), "Total = " & Round(Timer - tt, 3)
    ' Sort
    t = Timer
    Rng.Sort .Cells(2), xlAscending, .Cells(1), , xlAscending, Header:=xlNo
    If IsLog Then Debug.Print "Sort", Round(Timer - t, 3), "Total = " & Round(Timer - tt, 3)
  End With
    
  ' Put values into a()
  t = Timer
  a() = Rng.Columns(1).Value
  If IsLog Then Debug.Print "a()", Round(Timer - t, 3), "Total = " & Round(Timer - tt, 3)
    
  ' Main
  t = Timer
  For i = 1 To UBound(a)
    j = Len(a(i, 1))
    If j > 0 And a(i, 1) <> s Then
      s = a(i, 1)
      If Not IsObject(b(j)) Then Set b(j) = New Collection
      b(j).Add s
    End If
  Next
  If IsLog Then Debug.Print "Main", Round(Timer - t, 3), "Total = " & Round(Timer - tt, 3)
  
  ' Create/Append files
  t = Timer
  If Dir(p, vbDirectory) = "" Then MkDir p
  For i = LBound(b) To UBound(b)
    If IsObject(b(i)) Then
      ' Copy content of the Collection to the s
      j = 0
      ReDim a(1 To b(i).Count + 1)
      For Each v In b(i)
        j = j + 1
        a(j) = v
      Next
      Set b(i) = Nothing
      s = Join(a, vbCrLf)
      ' Append data to the end of file
      f = p & "\" & Format(i, "0000") & ".txt"
      FF = FreeFile
      Open f For Binary Access Write As FF
      Seek FF, LOF(FF) + 1
      Put FF, , s
      Close FF
    End If
  Next
  If IsLog Then Debug.Print "Files", Round(Timer - t, 3), "Total = " & Round(Timer - tt, 3)
  
End Sub
Изменено: ZVI - 29 Ноя 2017 11:56:30
Vladimir Zakharov
Microsoft MVP – Excel
Переход между разделами или колонтитулами разделов документа Word из VBA&Excel
 
Андрей, спасибо, исправил.
Изменено: ZVI - 20 Ноя 2017 05:37:50
Vladimir Zakharov
Microsoft MVP – Excel
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 127 След.