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

Страницы: 1 2 3 4 След.
Ранжирование по возрастанию для нескольких групп с повторами, Формула Excel
 
#
06.12.2023 10:16:35

​Форумчане, доброе утро! Бьюсь уже 3 неделю над следующей задачей: В столбце M нужна формула, которая будет присваивать порядковый номер в зависимости от значения в столбце AB и выбранного потребителя (столбец Z). РАНГ мне не помог, так как у меня много повторов, а им присваивается одинаковый номер. Помогите, пожалуйста. Спасибо!
 
Перейти    
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
#
13.06.2018 14:00:53
Форумчане, спасибо Вам за помощь (кто - советом, кто - делом), я похоже решил задачу с помощью нового кода (оставлю его как решение своего вопроса). Код собран на основе данной темы, чуть модифицирован на проверку условия (не равно "").

Код
Sub Condition_vibor4()

 'процедура формируем массив уникальных значений в выбранном диапазоне и вставляем его в указанную ячейку
    Dim cell As Range
    Dim Unique As New Collection
    Dim cellPaste As Range
    Dim UniqueArray()
            
    Dim A() As String
    Dim C As Collection
    Dim R As Range
    Dim I As Long
    
    Set C = New Collection
    
    On Error Resume Next
    For Each R In Worksheets("Sheet1").Range("G7:G16").Cells
        If R.Offset(0, 1) <> "" Then
        C.Add R.Value, CStr(R.Value)
        End If
    Next
    On Error GoTo 0
     
ReDim UniqueArray(1 To C.Count, 1 To 1)
   'переносим уникальные значения в массив
        For I = 1 To C.Count
            UniqueArray(I, 1) = C.Item(I)
        Next I
'определяем диапазон для вставки
    Set cellPaste = Range(Cells(1, 11), Cells(1, 11).Offset(C.Count - 1, 0))
   'вставляем массив в диапазон
' при вставке я пытался избежать цыкла (рекомендация одного автора учебника по VBA с примером).
' во всем диапазоне для вставки я получаю только первое значание массива
        cellPaste.Value = UniqueArray
     
Cells(1, 12) = "=SumIf($G$7:$G$16,K1,$H$7:$H$16)"
Cells(1, 12).Select
    Selection.AutoFill Destination:=Range("L1:L" & C.Count), Type:=xlFillDefault

End Sub
 
Перейти    
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
#
06.06.2018 16:59:15
Фактически нужен результат свода.
 
Перейти    
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
#
06.06.2018 16:46:52
Sanja,нет, этот код для суммы элементов. Я F8 проходил не раз, прежде чем писать на форум.

Код
Sub Condition_vibor4()
Dim i&, MySum As Long
For i = 7 To 20
    If Cells(i, 7) = "A" Or Cells(i, 7) = "B" Or Cells(i, 7) = "C" Then
        MySum = MySum + Cells(i, 8)
    End If
Next
Cells(1, 10) = MySum
End Sub

Update: мой код тоже не работает :( , если будет ряд из:

A
A
A789
B80
C8
C
F564
E23
D789
Изменено: Macedon - 06.06.2018 16:47:53
 
Перейти    
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
#
06.06.2018 16:21:30
Спасибо за отклики! По порядкуэ

Задача макроса: собрать ненулевые значения из колонки H, и записать элементы к которым относятся (в данном случае A, B и С). Фактически я хочу добиться вычислений из сводной таблицы, но без доп. листов, использования доп. ячеек и ненужной информации из свода (итого и т.д.). Понятно, что макрос работает только с отсортированными данными (A, B , С и т.д.), но я так и буду использовать.

Nordheim,
Код
i = i + 1
j = j - 1
Мне нужно, чтобы макрос шел по строкам вперед, без i=i+1 он оставит значение i прежним. А j=j-1, контролирует заполнение ячеек подряд в столбце, если не будет этой строки будут "бланки".
Код
If i > 19 Then
End
End If
Я планирую заменить 19 на макрос последней строки для колонки G. Без этой проверки у меня цикл "зацикливался" (не мог завершиться).
Изменено: Macedon - 06.06.2018 18:51:16
 
Перейти    
Собрать ненулевые значения из столбца и записать элементы, к которым относятся
 
#
06.06.2018 10:52:52
Добрый день! Написал код в VBA для отбора элементов (ненулевые, без повторов, столбец G) и расчет суммы по каждому элементу (аналогично суммесли). Код работает, но у меня есть вопрос - насколько я его правильно описал, такое ощущение, что усложнил код. Посмотрите, пожалуйста.
Код
Sub Condition_vibor4()

Dim i As Integer, j As Integer

'Описываем цикл
For i = 7 To 20 '7 - начало строки массива данных, а 20 - конец массива (можно заменить на "последнюю строку"

For j = 1 To 5 '1 - начальная строка для размещения данных, 5 - число зарезервированных строк под двнные

' условие для остановки макроса при достижении i = 20 и более
If i > 19 Then
End
End If
'

If Cells(i, 8) > 0 And Cells(j, 9) <> Cells(i, 7) And Cells(i, 7) <> Cells(i + 1, 7) Then
Cells(j, 9) = Cells(i, 7).Value
Cells(1, 10) = "=SumIf($G$7:$G$16,I1,$H$7:$H$16)"
i = i + 1
Else

If i = 18 Then
countvalues = Application.WorksheetFunction.CountA(Range("I1:I5"))
Cells(1, 10).Select
    Selection.AutoFill Destination:=Range("J1:J" & countvalues), Type:=xlFillDefault
End If

i = i + 1
j = j - 1
End If

Next j
Next i

End Sub
Спасибо!
 
Перейти    
VBA вставка строки между уникальными значениями
 
#
14.09.2017 17:24:31
Нашел ответ на свой вопрос (для столбца 1, а не 2), оставлю как решение (дополнил макрос немного на ограниченное исполнение) :
Код
Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

If Cells(2, 1) = "" Then
End
End If

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    iRow = iRow + 2
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'

End Sub
 
Перейти    
VBA вставка строки между уникальными значениями
 
#
14.09.2017 16:55:03
Добрый день! Написал код в VBA на добавление строки между уникальными значениями (в строках, столбец один и тот же), но не уверен что правильно написал процедуру. Может быть есть возможность как-то иначе описать процедуру (проще)?

Спасибо!
 
Перейти    
Сбор всех формул с листа на отдельный лист" (макрос)
 
#
11.09.2017 11:48:45
kuklp,вот это да! Спасибо Вам огромное!
 
Перейти    
Сбор всех формул с листа на отдельный лист" (макрос)
 
#
11.09.2017 11:07:39
Добрый день! Подскажите как можно решить данную задачу:

Нужно собрать все адреса ячеек с формулами и сами формулы с листа "Исходные данные" и вывести их как сделано на листе "Список формул";

Спасибо!
Изменено: Macedon - 11.09.2017 11:21:51
 
Перейти    
Userform: rак создать условие на зависимость Label от значений в нескольких Textbox
 
#
08.09.2017 13:15:22
Большое спасибо за помощь! Вариант С.М. помог=)

Попробовал вариант от Logistic, не то, так как зависит от порядка заполнения (сначала txt1, потом txt2), если менять поле после снятия лока с поля txt2.
Изменено: Macedon - 08.09.2017 13:16:47
 
Перейти    
Userform: rак создать условие на зависимость Label от значений в нескольких Textbox
 
#
08.09.2017 11:53:08
Добрый день! Помогите, пожалуста, с Userform. Я никак не могу прописать зависимость от нескольких Textbox для элемента Label. ЧТо нужно изменить, чтобы работало корректно? То есть нужно, чтобы Done, появлялось при условие что и в текстбоксах (txt1 и txt2) есть положительное значение (не 0 и не ""!) Постоянно обновляется, если идет изменение по текстбоксам (txt1 или txt2). Спасибо!
Код
Private Sub txt1_Change()
  If Me.txt1.Value > 0 And Me.txt2.Value > 0 Then
  Me.lbltext.Visible = True
  Else: Me.lbltext.Visible = False
  End If
End Sub
 
Перейти    
Смещение диапазона заполнения баз данных, Нужна помощь по коду в VBA
 
#
04.08.2017 12:44:01
panix1111,это я знаю, но как именно преобразовать IRow,. чтобы заполнялись строки последовательно - для меня загадка. При этом фиксировать IRow нельзя, так как пропадет функционал=(
 
Перейти    
Смещение диапазона заполнения баз данных, Нужна помощь по коду в VBA
 
#
04.08.2017 12:03:18
Добрый день! Помогите, пожалуйста, с кодом VBA (код не мой, но я вроде его освоил):
Код
Option Explicit

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")

'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtPart.Value
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

'clear the data
Me.txtPart.Value = ""
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtPart.SetFocus

End Sub

Интересует как поправить код, чтобы заполнение данных шло не с ячейки A1, а, например, F5 (и любой другой позиции). Лист для данных исходно пустой, потом нужно добавлять новые записи с новой строки. Сейчас код подсчитывает количество строк с данными и добавляет данные на 1 строку ниже. Можно ли как-нибудь привязать операцию, что если на листе есть ячейка с "Предмет", то данные из формы заполняются под этой ячейкой, а если под этим полем есть данные то добавляет на строку ниже?

Спасибо большое!
 
Перейти    
Форма ввода в базу данных, Ввод списка данных через форму ввода
 
#
04.08.2017 11:37:42
В Интернете нашел такую удобную форму для базы данных, можно адаптировать под свои нужды
 
Перейти    
Userform: вывод на передний план при смене активного окна, без возможности активации иного приложения / листа и т.д.  до выбора
 
#
18.07.2017 15:22:39
Пожонглировал немного с кодом - получил результат, но мне кажется, что есть решение получше...
Нужно поправить конец кода на:
Код
wda.WindowState = wdWindowStateMaximize
Next vib
 
Перейти    
Userform: вывод на передний план при смене активного окна, без возможности активации иного приложения / листа и т.д.  до выбора
 
#
18.07.2017 14:59:51
Цитата
Alemox написал:
UserForm1.Repaint
Не подходит - действует аналогично UserForm1.vbModeless show (разница в том, что форму не показывает, а макрос бежит вперед)

Цитата
Alemox написал:
вы везде всё активируете и выделяете в макросе
Дело в том что идет пересоздание закладок в ворд - я покак более удачного способа как
Код
wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_1"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
wda.Selection.Bookmarks.Add Name:="ob_1"
wda.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
''''
 
wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_2"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
wda.Selection.Bookmarks.Add Name:="ob_2"
wda.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
''''

не нашел:(
Код
Application.ScreenUpdating = False
Этот код разместить в самое начало макроса или в начале кода цикла?
Изменено: Macedon - 18.07.2017 15:01:04
 
Перейти    
Userform: вывод на передний план при смене активного окна, без возможности активации иного приложения / листа и т.д.  до выбора
 
#
18.07.2017 14:35:34
Добрый день! Бьюсь с формами и циклами уже несколько часов - все никак не получается: форма не выводится на передний план, а идет "мерцание" для выбора активного приложения как это устранить? UserForm1.vbModeless show - не предлагать, здесь нельзя, так как макрос "бежит дальше". Спасибо большое!

Здесь нужно, видимо, скорректировать код
Код
wda.WindowState = wdWindowStateMinimize
Windows("tesr.xlsm").Activate
UserForm1.Show

Код цикла:
Код
For vib = 1 To 10

wda.WindowState = wdWindowStateMinimize
Windows("tesr.xlsm").Activate
UserForm1.Show

'''''''''''''''''''''''''
'''''''''ЦИКЛ'''''''''''
'''''''''''''''''''''''''

''''
Range("C7:F15").Select
Selection.Copy
''''
With wda
.ActiveDocument.Bookmarks("ob_1").Select

End With

wda.Selection.PasteSpecial False, False, False

'
Application.CutCopyMode = False
'Очистка буфера обмена

''''
Range("C1:E5").Select
Selection.Copy
''''
With wda
.ActiveDocument.Bookmarks("ob_2").Select

End With

wda.Selection.PasteSpecial False, False, False

'
Application.CutCopyMode = False
'Очистка буфера обмена

''''
wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_1"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
wda.Selection.Bookmarks.Add Name:="ob_1"
wda.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
''''

wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_2"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
wda.Selection.Bookmarks.Add Name:="ob_2"
wda.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
''''

'''''''''''''''''''''''''
''''''КОНЕЦ ЦИКЛА'''''''
'''''''''''''''''''''''''
Next vib

End Sub
 
Перейти    
Пересоздание Bookmarks, Помощь с кодом
 
#
14.07.2017 15:54:38
Кажется работает, если вдруг что-то неправильно, то поправьте, пожалуйста.
Код
Sub forum()

Dim wda As Word.Application

On Error Resume Next

Range("C7:F15").Select
Selection.Copy
 
    On Error Resume Next

    Set wda = CreateObject("Word.Application")    ' создаём приложение Word (без подключения библиотеки Word)

    wda.Visible = True    ' делаем Word видимым
    
    Set wd = wda.Documents.Open("U:\Шаблоны\forum.docm")
 
With wda
.ActiveDocument.Bookmarks("ob_1").Select

End With

wda.Selection.PasteSpecial False, False, False

'
Application.CutCopyMode = False
'Очистка буфера обмена

wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_1"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
wda.Selection.Bookmarks.Add Name:="ob_1"
    
End Sub
 
Перейти    
Пересоздание Bookmarks, Помощь с кодом
 
#
14.07.2017 15:26:00
RAN,закладку не создал=(
 
Перейти    
Пересоздание Bookmarks, Помощь с кодом
 
#
14.07.2017 15:12:58
Добрый день! Форумчане, помогите с кодом - никак не могу из Excel пересоздать закладку в Word.
Код
Sub forum()

Dim wda As Word.Application

On Error Resume Next

Range("C7:F15").Select
Selection.Copy
 
    On Error Resume Next

    Set wda = CreateObject("Word.Application")    ' создаём приложение Word (без подключения библиотеки Word)

    wda.Visible = True    ' делаем Word видимым
    
    Set wd = wda.Documents.Open("U:\Шаблоны\forum.docm")
 
With wda
.ActiveDocument.Bookmarks("ob_1").Select

End With

wda.Selection.PasteSpecial False, False, False

'
Application.CutCopyMode = False
'Очистка буфера обмена

wda.Activate
wda.Selection.TypeParagraph
wda.Selection.TypeParagraph
wda.Selection.TypeText Text:="ob_1"
wda.Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="ob_1"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    
End Sub

Спасибо!
 
Перейти    
Найти 10 популярных сочетаний
 
#
26.06.2017 17:10:20
Я пока как идею озвучу, может пригодится:

Примените формулу =СЧЁТЕСЛИ($B$24:$F$48;C4), по ней будет видно какие блюда чаше всего заказывают:
Паста сах.1118
эмульс11211
крем4910
крем61110
крем5109
эмульс2139
Паста сах.558
крем388
Паста сах.227
эмульс3147
эмульс4157
Паста сах.446
крем276
Паста сах.335
крем164
Потом среди топ 5 заказываемых блюд проверить комбинации

Такой вариант вам подойдет?
Вот вроде так должно быть
Паста   сах.1крем6крем53
Паста сах.1эмульс1крем43
Паста сах.1крем42
Паста сах.1крем62
Паста сах.1эмульс12
Паста сах.1эмульс1крем52
Изменено: Macedon - 26.06.2017 17:37:29
 
Перейти    
Подсчет количества возможных значений в диапазоне
 
#
26.06.2017 14:48:52
Менять нижнюю границу в ячейке D5, верхнюю - в ячейке E5. Не забывать протягивать формулы!
 
Перейти    
Подсчет количества возможных значений в диапазоне
 
#
26.06.2017 14:29:27
АркадийР, да, сейчас попробую=)

Пока, чтобы не забыть:
Если у вас шаг меняется на 0,1, 0,5 и т.д., то для сколько диапазонов входит в указанный диапазон нужно применить формулу =СЧЁТЗ(E8:O18)-СЧИТАТЬПУСТОТЫ(E8:O18)
Изменено: Macedon - 27.06.2017 01:48:43
 
Перейти    
Подсчет количества возможных значений в диапазоне
 
#
26.06.2017 13:59:31
Поправил свой файлик, так как нижняя граница диапазона не может быть больше верхней.
 
Перейти    
Подсчет количества возможных значений в диапазоне
 
#
26.06.2017 13:48:34
АркадийР, так нужно?
 
Перейти    
Применение формул Excel в описание диапазона в VBA
 
#
22.06.2017 13:26:21
kavaka08,осмыслю ваш макрос, пока вроде работает. Щас попробую от yozhik,
Код
Sub Макрос5()

If Cells(4, 10) <> "" Then
Range(Cells(4, "J"), Cells(Cells(Rows.Count, "J").End(xlUp).Row, "J")).Copy
    End If
    
End Sub
Код
Sub Макрос6()

Dim k As Integer, m As Integer
If Cells(4, 10) <> "" Then
k = 4
m = Cells(Rows.Count, 10).End(xlUp).Row - 3
Range("J4").Resize(m, 2).Copy
    End If
    
End Sub

Update: Большое Вам спасибо, kavaka08и yozhik!То что, надо  :)  
Изменено: Macedon - 22.06.2017 13:32:38
 
Перейти    
Применение формул Excel в описание диапазона в VBA
 
#
22.06.2017 13:16:30
yozhik,это для одной из таблиц, будет несколько=)
 
Перейти    
Применение формул Excel в описание диапазона в VBA
 
#
22.06.2017 13:09:16
Юрий М написал:
Цитата
А зачем формулы? Прямо макросом и считайте.
Как?)

Так не получается;(

k = FormulaR1C1 = "=ROW(4)"
 
Перейти    
Применение формул Excel в описание диапазона в VBA
 
#
22.06.2017 13:05:38
Sanja,макрос должен копировать диапазон ячеек, который формируется за счет 2 перечисленных формул: 1 формула определяет начало диапазона, а 2 - конец. Я хочу избавиться от привязки к ячейкам и "прописать" эти формулу внутри макроса без ссылок на ячейки (за исключением внутренних диапазонов  $J$5:$J$9 и J4).
 
Перейти    
Страницы: 1 2 3 4 След.
Наверх