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

Страницы: 1 2 3 След.
Ускорить макрос
 
Не могу словами варазить Вам, Sanja свою благодарность :)
Огромное при огромное Вам спасибо :)
Ускорить макрос
 
Спасибо Вам огромное, Sanja :)
Я поняла, что нужно сделать.
Ускорить макрос
 
Здравствуйте,
В прододжение темы.
Я очень, очень старалась доработать макрос как мне надо.
Моих знаний на это не хватает. :(
Данные из столбца "С" прекрасно переносятся, но вот добавить еще из столбца "Х" у меня ни как не получается.
Ни как не могу понять, что в этой части надо заменить, чтобы данные брались из столбца "Х".
Я Вас очень прошу помогите мне, пожалуйста.

Код
With shAdmin
  For Each iCl In .Range("C1:C" & .Cells(.Rows.Count, 3).End(xlUp).Row).Cells
    If iCl = "Full Name" Then
    arr = iCl.Offset(, -1).CurrentRegion.Value
    For I = LBound(arr, 1) + 1 To UBound(arr, 1)
      If arr(I, 16) = "Yes" Then
        N = N + 1
        newArr(N, 1) = arr(I, 10)
        newArr(N, 2) = arr(I, 13)
        newArr(N, 3) = arr(I, 14)
        newArr(N, 4) = arr(I, 2)
        newArr(N, 5) = arr(I, 11)
        newArr(N, 6) = arr(I, 12)
        newArr(N, 7) = arr(I, 15)
        newArr(N, 8) = arr(I, 9)
        newArr(N, 9) = arr(I, 7)
        newArr(N, 10) = arr(I, 6)
        newArr(N, 11) = arr(I, 8)
      End If
    Next
  Next
End With
Ускорить макрос
 
Спасибо Вам Sanja за помощь.
Если честно, то думала что нужно внести небольшое исправление в имеющийся макрос.
Вы мне очень помогли.
Очень, очень большое спасибо.

П.С. Тренировка с макросом мое любимое занятие :)
Ускорить макрос
 
Цитата
написал:
Вы же сказали сами допилите? Я Вам схему накидал...
Если честно, не поняла, где именно надо допилить.
Простите, я не очень (от слова совсем) в макросах сильна.
Так сказать уровень совсем базовый  :)  
Ускорить макрос
 
Простите, еще один вопрос.
Мне нужно, чтобы таблица не очищалась, а дополнялась.
То есть если еще раз нажать на кнопку "ЖМИ", данные в таблицу добавились еще раз.
Это нужно, потому что каждый новый день дожен добавлять в таблицу Shift Approval
Ускорить макрос
 
Спасибо Вам большое, что откликнулись помочь.
Вот в приклепленном Вами примере, одно и тоже значение повторяется по несколько раз во второй части макроса.
Пожалуйста смотрите ниже.
Изменено: Marina55573 - 18.04.2025 15:44:57
Ускорить макрос
 
Уважаемый Sanja,
Спасибо Вам большое за первую часть. Работает очень быстро и как нужно.  :)
Вторая половина дописывается в таблицу на листе "Shift Approval".
То есть в итоге дожны быть данные за каждый день добавлены в одну таблицу.
Количество строк и столбцов не меняется.
Помогите мне пожалуйста со второй частью макроса.
Ускорить макрос
 
Цитата
Зачем Вам столько одинаковых Таблиц на одну и ту же дату? Может как-то по другому организовать исходные данные?
Каждая таблица, это зона где работают работники в этот день.
Зон много и они объеденены в группы.
И это утренняя, дневная и ночная смены. Поэтому таблицы повторяются.
К сожелению это утвержденный документ и я пытаюсь под него подстроиться.

Спасибо за Ваш код. Попробую.
Изменено: Marina55573 - 18.04.2025 15:21:04
Ускорить макрос
 
Здравствуйте БМВ,
Подскажите пожалуйста, а почему по два знака равно в каждой строке?
А что вот это строка макроса делает? просто хочу понять процесс.

Код
tAdminrow.Range(3).resize(1,12)=tArr
Ускорить макрос
 
Я попробую, просто файл очень сложный, а этот был как пример.
Скажите, а файл, в который данные переносятся, тоже надо приложить?
Ускорить макрос
 
Здравствуйте Sanja,
Это файл откуда копируются строки.
Макрос не весь, потому что это повторение того же процесса по всем группам строк.
А не могли бы вы написать как код должен выглядить, чтобы было как вы написали, пожалуйста.
Ускорить макрос
 
Здравствуйте уважаемые Форумчане,
Помогите пожалуйста с оптимизацией работы макроса.
Имеется рабочий файл, в котором администраторы распределяют людей по зонам работы.
Потом эти данные копируются из одного файла в другой файл в "умную" таблицу. Проблема заключается в том, что макрос, который я использую очень медленно переносит данные.
Помогите пожалуйста ускорить это, если это возможно. Файл пример приклеплен.
Здесь кусочек макроса, так как дальше процедура повторяется.
Спасибо за помощь.
Код
        Dim Admin As Worksheet
        Dim Adminobj As ListObject
        Dim Adminrow As Listrow
    
        Dim cell As String, arrData, i As Long
    
        
        Set Admin = Workbooks("ROSTER Admin V1.0.xlsm").Worksheets("Shift Approval")
        Set Adminobj = Admin.ListObjects("Shiftapp_tb")
    
        With Workbooks("ROSTER DM V1.0.xlsm").ActiveSheet
        arrData = .Range("AS5").CurrentRegion
        For i = 3 To UBound(arrData, 1)
        If arrData(i, 31) = "Yes" Then
            Set Adminrow = Adminobj.ListRows.Add
            Adminrow.Range(3) = arrData(i, 32)
            Adminrow.Range(4) = arrData(i, 4)
            Adminrow.Range(5) = arrData(i, 5)
            Adminrow.Range(6) = arrData(i, 1)
            Adminrow.Range(7) = arrData(i, 2)
            Adminrow.Range(8) = arrData(i, 3)
            Adminrow.Range(9) = arrData(i, 6)
            Adminrow.Range(10) = arrData(i, 7)
            Adminrow.Range(11) = 0
            Adminrow.Range(12) = arrData(i, 29)
            Adminrow.Range(13) = arrData(i, 10)
            Adminrow.Range(14) = arrData(i, 30)
        End If
        Next i
        End With
        
        With Workbooks("ROSTER DM V1.0.xlsm").ActiveSheet
        arrData = .Range("B5").CurrentRegion
        For i = 1 To UBound(arrData, 1)
        If arrData(i, 16) = "Yes" Then
            Set Adminrow = Adminobj.ListRows.Add
            Adminrow.Range(3) = arrData(i, 10)
            Adminrow.Range(4) = arrData(i, 13)
            Adminrow.Range(5) = arrData(i, 14)
            Adminrow.Range(6) = arrData(i, 2)
            Adminrow.Range(7) = arrData(i, 11)
            Adminrow.Range(8) = arrData(i, 12)
            Adminrow.Range(9) = arrData(i, 15)
            Adminrow.Range(10) = arrData(i, 9)
            Adminrow.Range(11) = arrData(i, 7)
            Adminrow.Range(12) = arrData(i, 6)
            Adminrow.Range(13) = arrData(i, 8)
        End If
        Next i
        End With
Макрос перестал работать
 
Здравствуйте, спасибо за Ваши ответы.
Оба файла в момент работы открыты.
Попробую совет от ВовавВова и MikeVol. Спасибо.
Цитата
P,S. Интересно Sheet2.Range("E3,E6") так и задумано или случайно?
Да, так задумано, чтобы очистить две этих ячейки. А это не правильно?
Макрос перестал работать
 
Здравствуйте Sanja,
Нет, ни каких ошибок не показывает.
Просто нажимаю на кнопку и ни чего не происходит.
Я проверяла включение макросов, все разрешено.
Макрос перестал работать
 
Здравствуйте уважаемые форумчане,
С наступивщим Вас новым годом!
Помогите пожалуйста советом.
Есть файл в нем отмечаю посещаемость. Ученики пришедшие отмечаются буквой Р и записываются в другой файл (как в базу данных).
Файл работал года 3-4 и вот перестал записывать.
Сразу хочу сказать, что файл находиться на другом компьютере и я пробовола на своем и все работает нормально.
Подскажите пожалуйста, что могло стать причиной сбоя. Может нужно что-то проверить.
Верисия Excel английская. Файл и файл база данных находяться на share drive в одной папке и пользуется только один человек в одно время.
Спасибо
Код
Sub Add_attend_data() ' add attandance to data file
    Dim Attend As Worksheet
    Dim Attendlistobj As ListObject
    Dim Attendrow As ListRow
    
    Dim Attenddata As Worksheet 'Sheet2 (all attendance data)
    Dim Attenddataobj As ListObject
    Dim Attenddatarow As ListRow
    
    Set Attend = ThisWorkbook.Worksheets("Attendance")
    Set Attendlistobj = Attend.ListObjects("Attendance_tb")
    Set Attenddata = Workbooks("DATA.xlsm").Worksheets("Attendance_data")
    Set Attenddataobj = Attenddata.ListObjects("Attend_data")
    Dim cell As String, arrData, i As Long
    Dim b As Double
    b = Application.Max(Workbooks("DATA.xlsm").Worksheets("Attendance_data").Range("Attend_data[Operation code]")) + 1
    
    With Worksheets("ATTENDANCE")
    cell = "P"
    arrData = .Range("C9").CurrentRegion
    For i = 2 To UBound(arrData, 1)
    If arrData(i, 13) = cell Then
        Set Attenddatarow = Attenddataobj.ListRows.Add
        Attenddatarow.Range(2) = b
        Attenddatarow.Range(3) = arrData(i, 1)
        Attenddatarow.Range(4) = Sheet2.Range("E3")
        Attenddatarow.Range(5) = Sheet2.Range("E6")
    End If
    Next i
    End With
    Delete_attend
    Sheet2.Range("E3,E6").ClearContents
    Sheet2.Range("Attendance_tb").ClearContents
    Sheet2.Range("Attendance_tb[belt]").ClearFormats
End Sub
Заполнить таблицу по порядку возростания (не сортировка)
 
Спасибо Бахтиёр  
Заполнить таблицу по порядку возростания (не сортировка)
 
Спасибо всем большое за помощь.
Формула не подходит, потому что количество строк может быть разное и не хочется много пустых строк.
Msi2102, спасибо за макрос.
Заполнить таблицу по порядку возростания (не сортировка)
 
Помогите, пожалуйста  
Заполнить таблицу по порядку возростания (не сортировка)
 
Здравствуйте Пытливый,
Спасибо, что написали.
Пожалуйста смотрите приклепленный файл.
Нужно с листа 'report data' перенести данные на лист 'report' в порядке номеров в столбце D.
Спасибо
Заполнить таблицу по порядку возростания (не сортировка)
 
Здравствуйте уважаемые форумчане,
Мне нужно данные из одной таблицу перенести в другую таблицу по порядку номеров (1,2,3 и т.д). Проблема в том, что значения в таблице расположены в случайном порядке и количество строк различное.
У меня есть макрос, который находит наименьшее значение и добавляет только одну строку.
Помогите пожалуйста скорректировать макрос, чтобы вносились все значения по порядку.
Спасибо
Код
Sub Fill_report()
    Dim cell As String, arrData, i As Long, n

    Dim Rpdata As Worksheet
    Dim Rpdataobj As ListObject
    Dim Rpdatarow As ListRow
    
    Dim Rp As Worksheet
    Dim Rpobj As ListObject
    Dim Rprow As ListRow
    
    Set Rpdata = ThisWorkbook.Worksheets("Report_data")
    Set Rpdataobj = Rpdata.ListObjects("Report_tb")
    
    Set Rp = ThisWorkbook.Worksheets("Report")
    Set Rpobj = Rp.ListObjects("Reportcharge_tb")
    n = Application.Min(Worksheets("Report_data").Range("Report_tb[Order check]"))

    With Worksheets("Report_data")
        arrData = .Range("A1").CurrentRegion
        For i = 2 To UBound(arrData, 1)
            If arrData(i, 4) = n Then
            Set Rprow = Rpobj.ListRows.Add()
                Rprow.Range(1) = arrData(i, 1)
            End If
        Next i
    End With
End Sub
Формат дат и чисел в английском и русском Excel
 
Я взяла тот файл, который выдавал ошибку в русской версии Excel.
Когда я сохранила файл, чтобы разместить его здесь, то пользовательская форма стала открываться, но показывать не правильные значения.
На листке System data три верхнии строки, это сохранение в русской версии Excel, а остальные в английской.
Пожалуйста смотрите прикрепленный файл.
Спасибо за помощь.  
Формат дат и чисел в английском и русском Excel
 
Доброе утро Webley,
Интересный вариант. Попробую сделать так как Вы написали.
Спасибо  
Формат дат и чисел в английском и русском Excel
 
Доброе утро БМВ,
У меня несколько строк в макросе с форматом дат и чисел.
Я думаю, что проблема именно в форматах, потому что после исправления чисел и дат в таблице в ручную на английский тип, пользовательская форма открылась.
Формат дат и чисел в английском и русском Excel
 
Здравствуйте уважаемые формучане,
Помогите с решением одного вопроса.
У меня Excel2013 английская версия. Я сделала файл, который должен работать в русском Excel2013.
Возникла ошибка в форматах дат и чисел.
Через пользовательскую форму заполняется таблица и данные из нее (таблицы) просматриваются тоже через пользовательскую форму.
При попытки открыть пользовательскую форму возникает ошибка "Разный тип"
Вот формат дат в макросе:
Код
Datanozzlerow.Range(2) = Format(Parts_used.TextBox2.value, "mm/dd/yyyy") 
И формат чисел:
Код
Parts_used.TextBox11.value = Format(cell.Cells(1, 3).value, "#,##0.00")
Подскажите пожалуйста, как изменить, чтобы формат работал в русской версии.
Заранее благодарю.
Ошибка 91 в макросе
 
Видимо Вы правы Hugo.
Я заменила Х на х вроде все работает.
Спасибо Вам огромное за помощь
Ошибка 91 в макросе
 
Странно, теперь не ругается, но и не записывает данные  
Ошибка 91 в макросе
 
Цитата
написал:
Посмотрите находит ли значение
Код
    [URL=#]?[/URL]       1      Set   x = Feeobj.ListColumns.Item(1).Range.Find(Feecharge_form.Typeoffee_lbox.List(i), LookAt:=xlWhole)   
 
т.е. если ли что-то в х
Когда выдает ошибку, я просматриваю коде наводя стрелку на каждую строку.
Мне показывает, что значение находит. Т.е. если я выделяю в listbox 'Joining fee', то в строке
Код
Set X = Feeobj.ListColumns.Item(1).Range.Find(Form.Typeoffee_lbox.List(i), LookAt:=xlWhole)
показывает 'Joining fee'.
но потом ругается на:
Код
Feedatarow.Range(3) = x.Cells(1, 2)
Ошибка 91 в макросе
 
Цитата
написал:
У меня не ругается.
Microsoft® Excel® 2019 MSO (версия 2301 16.0.16026.20002) 32-разрядная
У меня Excel 2013  
Ошибка 91 в макросе
 
Я закрыла файл и открыла снова. Да, не ругается.
Но в оригинальном файле именно эта строка прописана.
Код
b = Application.Max(Workbooks("DATA.xlsm").Worksheets("Otherfee_data").Range("Otherfee_tb[Operation code]")) + 1

Что еще возможно приводит к ошибке?
Страницы: 1 2 3 След.
Наверх