Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как изменить макрос чтобы данные располагались по порядку - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Как изменить макрос чтобы данные располагались по порядку
Makar1986 Дата: Четверг, 06.07.2017, 05:52 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте, я уже задавал вопрос на другом форуме My WebPage,но мне не помогли с решением вопроса, как можно изменить макрос чтобы данные заполнялись как на картинке. Заранее всем спасибо.
Пробовал так[vba]
Код
'Cells(iLR, "A") = .Cells(i - 1, "B") & Chr(10)
[/vba] данные выводятся, но не в нужном порядке. Бывает что выходит только название оборудования

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Workbooks.Open Filename:="\\srv-fs-1\usr\sklyuev\Desktop\Книга 2.xlsx" 'Открытие книги с данными
'abook.Worksheets("Освещение").Activate 'Активируем лист в книге
    If Not Intersect(Target, Range("E2")) Is Nothing Then
        Application.EnableEvents = False
Dim i As Long
Dim iLR As Long
Dim iLR_осв As Long
Dim FoundMonth As Range
    iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
If iLR < 7 Then iLR = 7
Range("A7:A" & iLR).ClearContents   'очищаем столбец А
Range("C7:C" & iLR).ClearContents   'очищаем столбец C
Range("D7:D" & iLR).ClearContents   'очищаем столбец D
Range("F7:F" & iLR).ClearContents   'очищаем столбец F
With Worksheets("Освещение")
' ищем столбец с месяцем
    Set FoundMonth = .Rows(4).Find(Target, , xlValues, xlWhole)
    If Not FoundMonth Is Nothing Then
        iLR_осв = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLR = 7
        For i = 8 To iLR_осв  'цикл по столбцу с найденным месяцем
        If InStr(1, .Cells(i, FoundMonth.Column), "ТР") <> 0 Then
            'Cells(iLR, "A") = .Cells(i - 1, "B") & Chr(10)
            Cells(iLR, "A") = .Cells(i, "B") 'оборудование где есть ТР
            Cells(iLR, "C") = "шт." ' единица измерения
            Cells(iLR, "D").FormulaR1C1 = _
        "=LEFT(RIGHT(IFNA(INDEX('[Книга 2.xlsx]Освещение'!C5:C16,MATCH(RC[-3],'[Книга 2.xlsx]Освещение'!C2,0),MATCH(R2C5,'[Книга 2.xlsx]Освещение'!R4C5:R4C16,0)),""""),3),1)"
            iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Next
    End If
End With
    End If
    With Worksheets("Кол-во часов")
     
      For i = 7 To iLR
        Set FoundObject = .Columns(2).Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not FoundObject Is Nothing Then
          Cells(i, "F") = FoundObject.Offset(, 2)
        End If
      Next
   End With
[/vba]
К сообщению приложен файл: _2-3.xlsm (24.8 Kb) · 0337260.xlsx (15.3 Kb)


Сообщение отредактировал Makar1986 - Четверг, 06.07.2017, 05:53
 
Ответить
СообщениеЗдравствуйте, я уже задавал вопрос на другом форуме My WebPage,но мне не помогли с решением вопроса, как можно изменить макрос чтобы данные заполнялись как на картинке. Заранее всем спасибо.
Пробовал так[vba]
Код
'Cells(iLR, "A") = .Cells(i - 1, "B") & Chr(10)
[/vba] данные выводятся, но не в нужном порядке. Бывает что выходит только название оборудования

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Workbooks.Open Filename:="\\srv-fs-1\usr\sklyuev\Desktop\Книга 2.xlsx" 'Открытие книги с данными
'abook.Worksheets("Освещение").Activate 'Активируем лист в книге
    If Not Intersect(Target, Range("E2")) Is Nothing Then
        Application.EnableEvents = False
Dim i As Long
Dim iLR As Long
Dim iLR_осв As Long
Dim FoundMonth As Range
    iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
If iLR < 7 Then iLR = 7
Range("A7:A" & iLR).ClearContents   'очищаем столбец А
Range("C7:C" & iLR).ClearContents   'очищаем столбец C
Range("D7:D" & iLR).ClearContents   'очищаем столбец D
Range("F7:F" & iLR).ClearContents   'очищаем столбец F
With Worksheets("Освещение")
' ищем столбец с месяцем
    Set FoundMonth = .Rows(4).Find(Target, , xlValues, xlWhole)
    If Not FoundMonth Is Nothing Then
        iLR_осв = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLR = 7
        For i = 8 To iLR_осв  'цикл по столбцу с найденным месяцем
        If InStr(1, .Cells(i, FoundMonth.Column), "ТР") <> 0 Then
            'Cells(iLR, "A") = .Cells(i - 1, "B") & Chr(10)
            Cells(iLR, "A") = .Cells(i, "B") 'оборудование где есть ТР
            Cells(iLR, "C") = "шт." ' единица измерения
            Cells(iLR, "D").FormulaR1C1 = _
        "=LEFT(RIGHT(IFNA(INDEX('[Книга 2.xlsx]Освещение'!C5:C16,MATCH(RC[-3],'[Книга 2.xlsx]Освещение'!C2,0),MATCH(R2C5,'[Книга 2.xlsx]Освещение'!R4C5:R4C16,0)),""""),3),1)"
            iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Next
    End If
End With
    End If
    With Worksheets("Кол-во часов")
     
      For i = 7 To iLR
        Set FoundObject = .Columns(2).Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not FoundObject Is Nothing Then
          Cells(i, "F") = FoundObject.Offset(, 2)
        End If
      Next
   End With
[/vba]

Автор - Makar1986
Дата добавления - 06.07.2017 в 05:52
Makar1986 Дата: Четверг, 06.07.2017, 05:55 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Вот добавил картинку как должно быть
К сообщению приложен файл: 0368738.png (81.8 Kb)
 
Ответить
СообщениеВот добавил картинку как должно быть

Автор - Makar1986
Дата добавления - 06.07.2017 в 05:55
Makar1986 Дата: Суббота, 08.07.2017, 08:00 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
я не знаю может кого то на толкнет на мысль, у меня название оборудования без цифр(но в примере с цифрами), то это должно облегчить работу, вот только понять не могу как это сделать
 
Ответить
Сообщениея не знаю может кого то на толкнет на мысль, у меня название оборудования без цифр(но в примере с цифрами), то это должно облегчить работу, вот только понять не могу как это сделать

Автор - Makar1986
Дата добавления - 08.07.2017 в 08:00
KuklP Дата: Суббота, 08.07.2017, 09:30 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеКросс:
http://www.planetaexcel.ru/forum....A%D0%B8

Автор - KuklP
Дата добавления - 08.07.2017 в 09:30
Pelena Дата: Суббота, 08.07.2017, 09:45 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19603
Репутация: 4660 ±
Замечаний: ±

Excel 365 & Mac Excel
Сергей, автор сам дал ссылку на кросс в первом посте yes


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСергей, автор сам дал ссылку на кросс в первом посте yes

Автор - Pelena
Дата добавления - 08.07.2017 в 09:45
KuklP Дата: Суббота, 08.07.2017, 16:46 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Привет, Леночек. Ну да. Сбило с толку, что ТС обозвал Планету - "My WebPage". Довольно самонадеянно, на грани самозванства :D Павлов бы удивился.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Суббота, 08.07.2017, 16:47
 
Ответить
СообщениеПривет, Леночек. Ну да. Сбило с толку, что ТС обозвал Планету - "My WebPage". Довольно самонадеянно, на грани самозванства :D Павлов бы удивился.

Автор - KuklP
Дата добавления - 08.07.2017 в 16:46
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!