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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 271 След.
Закрепление данных (ячейки) за числом, символом.
 
umnikov.au, можно настроить автозамену (Параметры - Правописание - Параметры автозамены)
Randomize + Rnd генерирует одинаковые числовые последовательности
 
Полу-офф. Красивейшее решение создания "эффекта матрицы" с использованием не совсем случайных последовательностей Rnd: http://www.cyberforum.ru/visual-basic/thread2203082.html#4
Перемножение чисел. Одно из чисел выбирается исходя из условия
 
sleping90, для 3 строки, формула массива
Код
=ИНДЕКС(C3:C99;ПОИСКПОЗ(ИСТИНА;ЕЧИСЛО(C3:C99);))*D3
VBA: добавить переменную в формулу
 
sokolale, да и цикл не нужен
Код
Sheets(15).Range("C8:C38").FormulaR1C1 = _
  "=IFERROR(VLOOKUP(R2C5,OFFSET(Deliveries,0,1,,11),3,0),"""")"
Последовательное присвоение значения "0" всем возможным комбинациям ячеек, В столбце 10 ячеек, каждый следующий столбец должен содержать значение "0" в разной ячейке, далее кол-во "0" возрастает
 
AlekseiBW,
Код
=ДЕС.В.ДВ(ОТБР(A1/262144);2)&ДЕС.В.ДВ(ОТБР(ОСТАТ(A1;262144)/512);9)&ДЕС.В.ДВ(ОСТАТ(A1;512);9)
Сортировка текстового столбца по величине числа, являющемуся частью текста
 
Или в Ворд перетащить, там сортировка тип: число, по убыванию(?). Потом перетащить обратно.
Как превратить таблицу в 1 колонку?
Удалить вкладки в Personal.xlsb
 
ЕжеВика, оставить только первый лист - в окне Immediate
Код
for n=2 to workbooks("personal.xlsb").sheets.count:workbooks("personal.xlsb").sheets(2).delete:next
VBA. Макрос очищения определенных столбцов по названию.
 
Billy,
Код
Sub Bi()
Dim x
  With ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$8").CurrentRegion, , xlYes)
    .TableStyle = ""
    For Each x In Split("ъ кк ее нн гг")              'перечислите заголовки столбцов через пробел
      .ListColumns(x).DataBodyRange.ClearContents
    Next
    .Unlist                                           'необязательно - преобразовать таблицу в обычный диапазон
  End With
End Sub
Код ячейку с формулой не принимает как значение
 
antwta, наверно
Код
If val(Range("$D$13").Value) <= 3 Then
VBA - убрать ячейки из zRange (As Range)
 
Цитата
Ігор Гончаренко написал:
допустим Вы с клавишей Ctrl отмечаете несвязный диапазон и случайно, промахнулись мышьюв отмеченный диапазон попала "левая" ячейка или группа ячеек. и теперь сколько чего не жми - снять отметку нечем!
В каком-то из новейших офисов исправили: https://mspoweruser.com/microsoft-is-fixing-one-of-the-most-annoying-issues-in-excel/
Как разнести данные в таблице
 
ymal_qeb, каким образом данные приходят и уходят? Если этим процессом управляет внешняя программа или скрипт, то она может и макрос запустить. В VBS это выглядит так
Код
xlApp.Run "Ym" 'xlApp - ссылка на приложение Excel, в котором открыта книга

В закрытой книге макрос работать не может. Может быть, Вы имеете в виду, что книга неактивна, невидима?
Как разнести данные в таблице
 
ymal_qeb,
1. вместо 18 строки
Код
  With Worksheets("Лист2") 'целевой лист
    .Cells.ClearContents
    .Range("A1").Resize(k, 3).Value = w
    .Activate 'необязательно
  End With

2. По какому событию? В обработчике события напишите вызов этой процедуры. Если лист с данными при этом не является текущим, его надо активировать или немного изменить строку 3
Код
  With Worksheets("Лист1") 'лист с данными
    v = .Range("A4", .Cells(.Rows.Count, "C").End(xlUp)).Value 'вместо А4 реальный адрес первой ячейки
  End With
ассоциировать zTextBox (As TextBox) с другим объектом типа TextBox (на странице UserForm)
 
RazorBaze, правильнее
Код
Dim zTextBox As msforms.TextBox
Потому что тип TextBox в Excel - это его "родной" текстбокс с панели "Формы" :)
А вообще можно As Object или без указания типа - Variant.
Как разнести данные в таблице
 
ymal_qeb, пробуйте
Код
Sub Ym()
Dim v(), d$(), f$(), g$(), i&, j&, k&, s$
  v = Range("A4", Cells(Rows.Count, "C").End(xlUp)).Value 'вместо А4 реальный адрес первой ячейки
  ReDim w(1 To UBound(v) * 10, 1 To 3)
  For i = 1 To UBound(v)
    d = Split(v(i, 2), "/")
    f = Split(v(i, 3), "/")
    j = InStrRev(v(i, 1), " ")
    g = Split(Mid$(v(i, 1), j + 1), "/")
    s = Left$(v(i, 1), j)
    For j = 0 To UBound(d)
      k = k + 1
      If j > UBound(g) Then w(k, 1) = s & g(0) Else w(k, 1) = s & g(j)
      w(k, 2) = d(j)
      If j > UBound(f) Then w(k, 3) = f(0) Else w(k, 3) = f(j)
    Next
  Next
  Worksheets.Add(, ActiveSheet).Range("A1").Resize(k, 3).Value = w
End Sub
Изменено: Казанский - 9 Авг 2018 10:23:41 (мин. правка)
Вставка значения в пустые ячейки диапазона
 
Цитата
RUSBelorus написал:
Как должен выглядеть код для вставки значения "Y" в пустые ячейки данного диапазона
Если ячейки действительно пустые, т.е. не содержат пустой строки, пробела
Код
on error resume next
range("I5",cells(rows.count,"I")).specialcells(xlcelltypeblanks)="Y"
Удалить всю кириллицу в ячейке
 
Альтернативный метод :)
Код
Sub Al()
Dim i&
  For i = Asc("А") To Asc("Я")
    Cells.Replace Chr(i), "", xlPart, , False, False, False, False
  Next
  Cells.Replace "Ё", "", xlPart, , False, False, False, False
  With ActiveSheet.UsedRange
    .Value = Application.Trim(.Value)
  End With
End Sub
Почему VBA find ищет не с первой строки?
 
Денис Мурченко, просто надо вторым параметром указать последнюю ячейку диапазона. И желательно явно указать остальные параметры.
Код
With Range("F1:F5")
  Range("B1").Value = .Find("Яблоко", .Cells(.Cells.Count), xlValues, xlPart, , xlNext).Value
End With
Почему VBA find ищет не с первой строки?
 
Денис Мурченко, внимательно читаем про параметр After
Цитата
If you don’t specify this argument, the search starts after the cell in the upper-left corner of the range
То есть поиск начинается после первой ячейки диапазона.
Условное форматирование с применением формулы макросом., Обработка стлобцов условным форматированием с помощью макроса.
 
Sarmat17, ко всей таблице примените одно правило УФ с формулой
Код
=B4>B$1
Изменено: Казанский - 7 Авг 2018 21:21:23
Сохранение и/или изменения цвета элемента массива, Сохранение и/или изменения цвета элемента массива
 
Android1, добавляйте текст такой командой
Код
ActiveCell.Characters(0, 0).Insert Vxod & Chr(10)
"Вытащить" время начала и окончания работы сервера.
 
Log4, можно расширенным фильтром перенести нужные строки на другой лист, а там уже проще будет
Код
Sub Lo()
Dim r As Range, c As Range
  Set r = Range("A2", Cells(Rows.Count, "C").End(xlUp).Offset(1))
  Set c = Range("E2:E3")
  c(2).Formula = "=AND(ABS(MOD(B3,1)-""7:30"")<=--""0:30"",OR(C3=""да "",AND(C3=""нет "",OR(C4={""да "",""""}))))"
  Worksheets.Add , ActiveSheet
  r.Resize(1, 2).Copy Range("A2")
  r.AdvancedFilter xlFilterCopy, c, Range("A2:B2")
  c.ClearContents
End Sub
Подбор масштаба листа отображаемого на мониторе, Печать и просмотр
 
banks, Вид - разметка страницы, 100%
"Вытащить" время начала и окончания работы сервера.
 
Log4, а почему Сервер(1) 05.08.2018 8:06:08-05.08.2018 8:08:27 закрашено серым и не попало в отчет? Или надо только первые 6 событий?
Запись\чтение нескольких массивов из txt файла
 
nassimtaleb, это учебное задание и нужно считать и записать текстовый файл именно в таком формате?
Дело в том, что VBA имеет средства для записи массивов в файл целиком и последующего чтения. Но в текстовом редакторе такой файл имеет совсем другой вид.
Попробуйте
Код
Sub Prorab1()
Dim прораб(), работник()
  прораб = Array("Вася", "Петя")
  работник = Array("Женя", "Саша", "Андрей")
  Open "c:\temp\prorab.txt" For Random As #1 'папка c:\temp\ должна существовать
  Put 1, , прораб
  Put 1, , работник
  Close 1
End Sub

Sub Prorab2()
Dim прораб(), работник()
  Open "c:\temp\prorab.txt" For Random As #1
  Get 1, , прораб
  Get 1, , работник
  Close 1
  Stop 'смотрите содержимое массивов в Locals
End Sub
[VBA] Сделать подсчет символов в ячейке и если их меньше 50, то прибавить в конце пробел/пробелы
 
Еще пара вариантов
Код
  s = Space$(50)
  LSet s = "Иванов"
Обычно такое бывает нужно при выводе в файл (с последующей распечаткой). Можно так
Код
  Print #file, "Иванов"; Tab(51)
Как удалить пары одинаковых значений в разных столбцах
 
Puzo,
Код
Sub Pu()
Dim i&, j
  Application.ScreenUpdating = False
  i = 2
  Do
    If Cells(i, "C") Then
      j = Application.Match(Cells(i, "C"), Columns("D"), 0)
      If Not IsError(j) Then
        Rows(j).Delete
        If j < i Then i = i - 1
        Rows(i).Delete
      Else: i = i + 1
      End If
    Else: i = i + 1
    End If
  Loop Until IsEmpty(Cells(i, "A"))
  Application.ScreenUpdating = True
End Sub
ячейки с зада :), и такое бывает
 
Бенефис
Прогрессия с даданными параметрами
 
mihail_ms, а, ну да
Код
Sub Mi()
Dim v(), i&, j&, k&, m&
  v = Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Resize(5).Value2
  ReDim w(1 To [SUM(3:3,5:5)-SUM(2:2,4:4)+COUNT(2:2,4:4)], 1 To 2)
  For i = 1 To UBound(v, 2)
    For k = v(2, i) To v(3, i) Step 2
      j = j + 1
      w(j, 1) = v(1, i)
      w(j, 2) = k
    Next
    For k = v(4, i) To v(5, i) Step 2
      j = j + 1
      w(j, 1) = v(1, i)
      w(j, 2) = k
    Next
  Next
  Worksheets.Add(, ActiveSheet).Range("A1").Resize(j, 2).Value = w
End Sub
крч
Код
Sub Mi()
Dim v(), i&, j&, k&, m&
  v = Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Resize(5).Value2
  ReDim w(1 To [SUM(3:3,5:5)-SUM(2:2,4:4)+COUNT(2:2,4:4)], 1 To 2)
  For i = 1 To UBound(v, 2)
    For m = 2 To 4 Step 2
      For k = v(m, i) To v(m + 1, i) Step 2
        j = j + 1
        w(j, 1) = v(1, i)
        w(j, 2) = k
  Next k, m, i
  Worksheets.Add(, ActiveSheet).Range("A1").Resize(j, 2).Value = w
End Sub
Изменено: Казанский - 3 Авг 2018 11:02:46
Прогрессия с даданными параметрами
 
mihail_ms, на скорую руку. Стиль ссылок приложения должен быть А1
Код
Sub Mi()
Dim v(), i&, j&, k&, m&
  v = Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Resize(5).Value2
  ReDim w(1 To [SUM(3:3,5:5)-SUM(2:2,4:4)+COUNT(2:2,4:4)], 1 To 2)
  For i = 1 To UBound(v, 2)
    For k = v(2, i) To v(3, i)
      j = j + 1
      w(j, 1) = v(1, i)
      w(j, 2) = k
    Next
    For k = v(4, i) To v(5, i)
      j = j + 1
      w(j, 1) = v(1, i)
      w(j, 2) = k
    Next
  Next
  Worksheets.Add(, ActiveSheet).Range("A1").Resize(j, 2).Value = w
End Sub
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 271 След.