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

Страницы: 1 2 3 4 5 6 След.
Выделение только видимых ячеек VBA
 
Попробуйте:
Код
Sub естьфильтр()
    'Range([A1].Offset(1, 2).Resize(2, 1).SpecialCells(xlCellTypeVisible).Address).Select
    
    With ActiveSheet.Range("A1").CurrentRegion
        .Offset(1, 2).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select
    End With
End Sub
Пополнение массива из отфильтрованного диапазона
 
... и следующий вариант:
Код
Option Explicit

Sub Makros1()
    Dim i&, j%, indR&, indC%, tbl()
    Dim rRng As Range, sngArea As Range, rowRng As Range
    
    Application.ScreenUpdating = False
    With ActiveSheet
        With .Range("A1").CurrentRegion
            indR = .Rows.Count - 1: indC = .Columns.Count
            .AutoFilter Field:=1, Criteria1:="<>4"
            Set rRng = .Offset(1, 0).Resize(indR, indC).SpecialCells(xlCellTypeVisible)
            .AutoFilter
            indR = 0: indC = 0
            For Each sngArea In rRng.Areas
                indR = indR + sngArea.Rows.Count
            Next
            indC = rRng.Columns.Count
            ReDim tbl(1 To indR, 1 To indC)
            For j = 1 To indC
                i = 0
                For Each rowRng In rRng.Rows
                    i = i + 1: tbl(i, j) = rowRng.Cells(j).Value
                Next
            Next
        End With
        .Range("D1").Resize(indR, indC).Value = tbl
        Erase tbl
    End With
    Application.ScreenUpdating = True
End Sub
VBA скрипт для Excel - Как вставить значение из mdb файла Access по SQL запросу без названия столбца
 
Если вам не нужны новые определённые имена (типа "Query-39008 *") в книге/листе, созданные при каждом выполнении "QueryTables", то также используйте ".Delete" (в самом конце), например:
Код
Sub SQLQuery_2()
    Const varSQL$ = "SELECT HCountItem FROM cut_tools WHERE cut_name='A141'"
    Dim varConn As String: varConn = "ODBC;DBQ=\\Server-esko\ae_base\BD_CutTools.mdb;Driver={Driver do Microsoft Access (*.mdb)}"
    
    With ActiveSheet
        .Range("A1").CurrentRegion.ClearContents
        With .QueryTables.Add(Connection:=varConn, Destination:=.Range("A1"))
            .CommandType = xlCmdSql
            .CommandText = varSQL
            .Name = "Query-39008"
            .FieldNames = False
            .Refresh BackgroundQuery:=False
            .Delete
        End With
    End With
End Sub
VBA скрипт для Excel - Как вставить значение из mdb файла Access по SQL запросу без названия столбца
 
Используйте ".FieldNames = False"
Вставить формулу массива через vba
 
Цитата
Kcuxa_xa написал:
я заполнила столбец C, в остальных столбцах  форумлы однообразные с единственным изменяемым параметром в строке 12, можно как-то автоматически их вставлять в столбцы D:T на основе этих формул?
вместо:
Код
    Range("C12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("D12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;4;1)"
    Range("E12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("F12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("G12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("H12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("I12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("J12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("K12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("L12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("M12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("N12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("O12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("P12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("Q12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("R12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("S12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
    Range("T12").FormulaLocal = "=ИНДЕКС(Автотранспорт!$A:$A;3;1)"
введите:
Код
    Range("D12").Formula = "=INDEX(Автотранспорт!$A:$A,4,1)"
    Range("C12,E12:T12").Formula = "=INDEX(Автотранспорт!$A:$A,3,1)"
    Range("C12:T12").Value = Range("C12:T12").Value
[ Закрыто] Требуется помощь с VBA, Сравнить два столбца с разным количество элементов
 
Цитата
amit03 написал:
... сравнить два столбца которые находятся в разных файлах. Один столбец ..., второй ...
Хорошо, но эти столбцы (первый и второй) включены в какие-то таблицы или свободные колонки ?
Сгенерировать случайные неповторяющиеся числа
 
и еще в коллекцию ...
Код
Option Explicit

Sub poneslo_chislo()
    Dim chislo As Double, i As Long, kolvo As Long, niz As Long, ver As Long
    
    niz = 1                         'nizhnyy razmer
    ver = Range("b11").Value        'verkhniy razmer
    kolvo = Range("b13").Value      'kolichestvo
    
    i = Cells(Rows.Count, "d").End(xlUp).Row
    If i < 11 Then i = 11
    Range("d11:d" & i).ClearContents
    
    Randomize
    'Drugoy variant
    'Range("d11").Value = Int((ver - niz + 1) * Rnd + niz)
    
    'Drugoy variant
    'For i = 2 To kolvo
    For i = 1 To kolvo
        chislo = Int((ver - niz + 1) * Rnd + niz)
        Do Until TypeName(Application.Match(chislo, Range("d11:d" & i + 10), 0)) = "Error"
        'Drugoy variant
        'Do Until TypeName(Application.Match(chislo, Range("d11:d" & i + 10 - 1), 0)) = "Error"
            chislo = Int((ver - niz + 1) * Rnd + niz)
        Loop
        Range("d" & i + 10).Value = chislo
    Next
End Sub
Округление до 9
 
?
=FLOOR(B1,10)-1
?
Перемещение 8000 листов Эксель на один лист
 
Цитата
tayers написал:
Данные .csv записаны в строчки через запятую
Tayers, дайте пример таких csv-файлов вместо говорить об этом ...
Цитата
tayers написал:
... получаются крупные целые числа, например 45862 и 34926
... а знаете, на тот пример, тут у нас уже нет зимы, сегодня в полдень, значит 43514,5 было +15 гродусов ... вот какая холодрыга ... : ) ...
Смешение диапазона макроса
 
1. Измените порядок макросов в "CommandButton1_Click":
Код
Private Sub CommandButton1_Click()
    'Call DoThis_Проежка
    Call DoThis_Борт
    Call DoThis_Проежка
End Sub
2. В "DoThis_Проежка" измените:
Код
i = 1
на
Код
i = Cells(8, Columns.Count).End(xlToLeft).Column
, если я хорошо понял.
Сведение в ячейку - слов, начинающихся с буквы "А" и заканчивающихся символами "+" или ","
 
Цитата
OlegSmirnov написал:
а может быть двузначное - например 12
Какое наибольшее число после "А" ?
Может быть 111222333 (A111222333) ?
Сведение в ячейку - слов, начинающихся с буквы "А" и заканчивающихся символами "+" или ","
 
Цитата
OlegSmirnov написал:
сперва идет буква "А", потом какое-то число
Какой диапазон чисел возле 'А', или только от 0 до 9, или больше, например: 112, 548, 965 985 985 985 ... ?
Рандом Вихрь Мерсенна для ВБА, Как указать на какие значение, и это значение вставить в переменную?
 
Можно тоже использовать функцию 'rand' из msvcrt runtime library
Код
Option Explicit

Declare Function rand Lib "msvcrt" () As Long

Sub rand_msvcrt()
    Dim i&, j%, psevdosluchaynoye_chislo
    For i = 1 To 10
        For j = 1 To 10
            psevdosluchaynoye_chislo = rand / 32767 'diapazon 0 - 1
            Cells(i, j).Value = psevdosluchaynoye_chislo
        Next
    Next i
End Sub
Изменено: ocet p - 15 Фев 2019 17:07:21
vba listbox результаты поиска, В listbox, в результатах поиска отобразить строку с 3 значениями
 
Цитата
cikkoni написал:
на форме с listbox , в результатах поиска отобразить три столбца где будут видны Номер рег, ФИО, IDNP

Цитата
V написал:
ListBox1.AddItem Cells(i, 1)
Другой способ:
Код
Option Explicit

Private indks&, tbl()

Private Sub UserForm_Initialize()
    Dim strk&, i&
    With Sheets("List1")
        strk = .Cells(.Rows.Count, "B").End(xlUp).Row
        tbl = .Range("A2:C" & strk).Value
    End With
    indks = strk - 1
    For i = 1 To indks
        tbl(i, 1) = Application.Trim(tbl(i, 1))
        tbl(i, 2) = UCase(tbl(i, 2))
        tbl(i, 3) = Format(tbl(i, 3), "0000000000000")
    Next
    With UserForm1
        With .ListBox1
            .ColumnCount = -1
            .ColumnWidths = "4cm;12cm;4cm"
            .TextColumn = 1 'Dlya znacheniya v "ListBox1.Text" => "Nomer_per"
            .BoundColumn = 2 'Dlya znacheniya v "ListBox1.Value" => "Familiya Imya Otchestvo"
            .List() = tbl
            .ListIndex = -1
        End With
    End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Erase tbl
End Sub

Private Sub TextBox1_Change()
    With UserForm1
        If Trim(.TextBox1.Value) = "" Then
            With .ListBox1
                .Clear
                .List() = tbl
            End With
            Exit Sub
        End If
        Dim i&, j&, tmptbl()
        For i = 1 To indks
            If tbl(i, 2) Like "*" & UCase(.TextBox1.Value) & "*" Then
                j = j + 1
                ReDim Preserve tmptbl(1 To 3, 1 To j)
                tmptbl(1, j) = tbl(i, 1)
                tmptbl(2, j) = tbl(i, 2)
                tmptbl(3, j) = tbl(i, 3)
            End If
        Next
        With .ListBox1
            .Clear
            If j > 0 Then
                .Column() = tmptbl
                Erase tmptbl
            End If
        End With
    End With
End Sub

Private Sub ListBox1_Click()
    Dim strk&, gde_eto As Range
    With Sheets("List1")
        strk = .Cells(.Rows.Count, "B").End(xlUp).Row
        With .Range("B1:B" & strk)
            Set gde_eto = .Find(UserForm1.ListBox1.Value, , xlValues, xlWhole, xlByRows)
        End With
        .Range("B" & gde_eto.Row).Select
        Set gde_eto = Nothing
    End With
End Sub

Цитата
cikkoni написал:
разобрался
Хорошо, только вам надо помнить, что на отфильтрованным списке "Cells(ListBox1.ListIndex + 1, 2).Select" может маркировать не те ячейки которые вы хочете.

Цитата
Nordheim написал:
в итоге одно и тоже ListBox пустой
:)  ... вы поймали меня на ... mental shortcut ... как это на русском будет ... умственный ярлык ... ?
Как бы не смотреть, сначала есть -1 потом есть маркировка/обозначение, потом есть Click.
Подсчет количества значений в ListBox
 
Цитата
Дмитрий Ч написал:
чтобы значения менялись не по даблклику а при изменении данных в листбоксе
А как эти значения должны быть обновлены ?
Из рабочего листа или из списка, что будет предметом изменения ?
В вашем коде есть "UserForm1.Show 0" - поэтому неизвестно, с кода (ListBox1) или с листа ?
Подсчет количества значений в ListBox
 
Anchoret, неверные данные попадают в текстовые поля, например увеличьте количество вхождений для "333" и проверьте - это потому, что данные не отсортированы.
Подсчет количества значений в ListBox
 
Цитата
Дмитрий Ч написал:
и присвоить им переменные
значит каким образом ?
в массив, словарь и т. д. ?
vba listbox результаты поиска, В listbox, в результатах поиска отобразить строку с 3 значениями
 
В ваших макросах:
1. Что такое ?
Код
...
Cells(ListBox1.List(0, 0), 2).Select
...
ListBox1.List(0, 0) => это не номер строки, должно быть => ListBox1.ListIndex + 1

2. Что такое ?
Код
Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub ' => A.
    Cells(ListBox1.Value, 2).Select          ' => B.
End Sub
A. Если вы выбираете какой-то запись в списке, как он может иметь индекс -1 ?
Может вы имели в виду " If ListBox1.ListCount = 0 Then Exit Sub " ?

B. ListBox1.Value => зависит от ListBox1.BoundColumn => это не номер строки
ListBox1.Text => зависит от ListBox1.TextColumn

Смотрите в контекстной помощи.

3. У вас вообще нет процедуры инициализации "UserForm", почему?
Вывод массива на лист без циклическим способом
 
Цитата
vikttur написал: Зачем такие имена переммых?
Не знаю, этот вопрос ко мне или к IgorBoot ?

Цитата
Nordheim написал: Транспонирование не всегда подходит ... можно получить ошибку
И поэтому я не очень люблю "эту транспонирование", и редко использую.
Вывод массива на лист без циклическим способом
 
Да, конечно, можно и так, правда, но это не всегда удобно. Во всем этом я имел в виду транспонирование, а не какой-то конкретный размер.
Вывод массива на лист без циклическим способом
 
Опуская вопрос о циклах, в этом случае транспонирование не обязательно, это зависит от декларации массива.
Кроме того, как вы заполняете матрицу "автоматически" (без цикла), она есть декларирована с размером (строки, колонии), с первыми  размерами элементов с индексом = 1.
Код
Sub Obmen_Massivami()
    Dim Peremennaya_Massiva As Variant
    Dim Vsego_Elementov As Long
    
    Vsego_Elementov = 10
    'ReDim Peremennaya_Massiva(1 To Vsego_Elementov)
    ReDim Peremennaya_Massiva(1 To Vsego_Elementov, 1 To 1)
    
    For i = 1 To Vsego_Elementov
        'Peremennaya_Massiva(i) = Cells(i, 1)
        Peremennaya_Massiva(i, 1) = Cells(i, "A")
    Next i
    For i = 1 To Vsego_Elementov
        'Cells(i, 3) = Peremennaya_Massiva(i)
        Cells(i, "C") = Peremennaya_Massiva(i, 1)
    Next i
    
    '[E1].Resize(UBound(Peremennaya_Massiva)).Value = Peremennaya_Massiva
    [E1].Resize(Vsego_Elementov, 1).Value = Peremennaya_Massiva
End Sub
Процедура нажатия кнопки срабатывает раньше чем проверка на корректность данных в Textbox_exit
 
Цитата
vsahno написал:
строка вызывает ошибку времени выполнения: run-time error
Так в общем, не знаю, что вы хотите сделать, но попробуйте так, может это сработает (смотрите файль).
Цитата
vsahno написал:
эта ваша заливная рыба-VBA
??? Какая же вновь рыба ???
"ocet" это на русском значит рыба ?
Вот прикольно, не знал ... :) ...


Удаление определенного текста из списка
 
… так и ещё один код … похож на код Anchoret ... :)
Код
Option Explicit

Sub def()
    Dim arr: arr = Range("C4:C18").Value
    Dim i&, poisk: poisk = Range("E20").Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = poisk Then Exit For
    Next
    If i > UBound(arr, 1) Then Exit Sub
    arr(i, 1) = ""
    For i = i To UBound(arr, 1) - 1
        arr(i, 1) = arr(i + 1, 1)
    Next
    Range("C4:C18").Value = arr: Erase arr
End Sub
Удаление определенного текста из списка
 
Цитата
eeigor написал:
Так не пойдет: нужно в цикле. Значений может быть >1
не нужно (у вас есть только один текст в вашей ячейке) ... :) ... но записи под таблицей (под "C18") мешают ... :)
Изменено: ocet p - 10 Фев 2019 21:48:21
Удаление определенного текста из списка
 
Код
Option Explicit

Sub abc()
    Dim teS, r&
    With Range("C4:C18")
        Set teS = .Find(Range("E20").Value, .Cells(.Cells.Count), xlValues, xlWhole, xlByRows)
    End With
    If teS Is Nothing Then Exit Sub
    For r = teS.Row To Range("C4:C18").Rows.Count
        Cells(r, "C").Value = Cells(r + 1, "C").Value
    Next
End Sub
но как что-то под "с18" будет то ... :) ...
Изменено: ocet p - 10 Фев 2019 21:30:49
Отображение в ListBox только видимых строк
 
Цитата
Дмитрий Ч написал:
только видимые строки, после отбора автофильтром
Вы должны (по моему мнению) использовать ".SpecialCells (xlCellTypeVisible)", а затем ".Areas" для просмотра всех видимых областей ячеек/строк
Combobox с поиском, VBA
 
... и может проверьте ещё одну модификацию кода Андрея VG, как она у вас срабатывает ...
Код
Private Sub cmbNames_Change()
    Dim indks As Long
    Dim sText As String
    
    sText = Trim$(cmbNames.Value)
    indks = cmbNames.ListIndex
    
    If Len(sText) = 0 Then
        cmbSource.Filter = ""
    Else
        If indks = -1 Then cmbSource.Filter = "names Like '*" & sText & "*'"
    End If
    
    If cmbSource.RecordCount = 0 Then
        cmbNames.List = Array("[не найдено соответствия]")
        Exit Sub
    End If
    
    cmbSource.MoveFirst
    cmbNames.Column = cmbSource.GetRows
    cmbNames.DropDown
End Sub
Combobox с поиском, VBA
 
Цитата
lis2109 написал:
почему-то поиск останавливался после ввода первой буквы
Код был адаптирован к этому:

Цитата
lis2109 написал:
при попытке перехода по списку с помощью стрелок на клавиатуре, в списке просто выбирается первое значение

, не для ручного ввода данных. Код содержит строку (cmbSource.Filter = "names Like '*" & sText & "*'"), отвечающую за фильтрацию введенного текста, которую необходимо изменить/настроить/записать по-другому, и так далее ... или изменить что-то в коде в другом месте, чтобы получить то, что вы хотите.
Процедура нажатия кнопки срабатывает раньше чем проверка на корректность данных в Textbox_exit
 
Цитата
vsahno написал: Если после ввода значения в Textbox перейти на какой нибудь элемент формы по табуляции ... Textbox_exit работает.
Однако если ... сразу мышкой нажать кнопку "сохранить" То процедура нажатия кнопки срабатывает раньше чем Textbox_exit.
Всё нормально ... "Textbox_exit" связано с фокусировкой объекта, с появлением и потерей фокусировки (и "Таб order"; порядок табуляции), ну, видно кнопка у вас не переносит фокуса на другой объект. Порядок событий при перемещении фокуса:
UserForm_Initialize => TextBox1_Enter => TextBox1_Change => перемещение фокуса => TextBox1_BeforeUpdate => TextBox1_AfterUpdate => TextBox1_Exit => TextBox2_Enter => перемещение фокуса

Попробуйте:
Combobox с поиском, VBA
 
Вы бы могли попробовать этот путь:
(Замените следующую процедуру "cmbNames_Change")

Код
Private Sub cmbNames_Change()
    Dim sText As String
    Static stoy As Boolean
    
    sText = Trim$(cmbNames.Value)
    cmbNames.DropDown
    
    If stoy Then
        If sText = "" Then stoy = False: GoSub abcdefg
        Exit Sub
    End If
    
    If Len(sText) = 0 Then
        GoSub abcdefg
    Else
        cmbSource.Filter = "names Like '*" & sText & "*'"
        If cmbSource.RecordCount > 0 Then
            stoy = True
            cmbSource.MoveFirst
            cmbNames.Column = cmbSource.GetRows
        Else
            cmbNames.List = Array("[не найдено соответствия]")
        End If
    End If
    
Exit Sub
abcdefg:
    cmbSource.Filter = ""
    cmbSource.MoveFirst
    cmbNames.Column = cmbSource.GetRows
    Return
End Sub

, но я не знаю, будет ли Андрей VG доволен таким решением ... : ) ...
Изменено: ocet p - 9 Фев 2019 22:40:48
Страницы: 1 2 3 4 5 6 След.
Наверх