Страницы: 1
RSS
Записать в одну строку макросом
 
Здравствуйте.
Помогите, пожалуйста, макросом заполнить ячейки в столбце А данными в одну строку через запятую
в соответствии с заполненными ячейками в столбцах C, D, E, F как в примере.
Данные в столбцах  C, D, E, F меняются в рукопашную, а записи в столбце А меняются макросом.
Заранее благодарен.
П.С. С правилами ознакомлен. Нарушений не наделал.
 
Добрый день
А в столбе а должны быть названия заполненных столбцов или числа из них?
 
В модуль Sheet1
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("C:F")) Is Nothing Then
        Application.EnableEvents = False
Dim j As Integer
  Range("A" & Target.Row).ClearContents
    For j = 3 To 6
      If Not IsEmpty(Cells(Target.Row, j)) Then
        Range("A" & Target.Row) = Range("A" & Target.Row) & Split(Cells(1, j), " ")(1) & ", "
      End If
    Next
      Range("A" & Target.Row) = Left(Range("A" & Target.Row), Len(Range("A" & Target.Row)) - 2)
  End If
    Application.EnableEvents = True
End Sub
 
Уважаемые, спасибо за отклик.
Kuzmich,Ваш макрос работает почти как надо. Если вносить данные в ячейки или удалять данные из них по одной штучке,
то макрос работает. А если же вставить данные кучкой (т.е. вставлять в несколько строк сразу), то в столбце А происходят изменения только в верхней строке,
а остальные остаются без изменений. Прошу подправить , если есть такая возможность.
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("C:F")) Is Nothing Then
    Application.EnableEvents = False
Dim j As Integer
Dim Target1 As Range
For Each Target1 In Target.Rows
  Range("A" & Target1.Row).ClearContents
    For j = 3 To 6
      If Not IsEmpty(Cells(Target1.Row, j)) Then
        Range("A" & Target1.Row) = Range("A" & Target1.Row) & Split(Cells(1, j), " ")(1) & ", "
      End If
    Next
      Range("A" & Target1.Row) = Left(Range("A" & Target1.Row), Len(Range("A" & Target1.Row)) - 2)
Next Target1
  End If
    Application.EnableEvents = True
End Sub
 
К сожалению, так вообще не работает.
При изменениях в столбцах С:F , в столбце А не происходит никаких изменений...
 
А ошибок в процессе выполнения не было? Если, например, очистить все ячейки, то в строке 13 будет ошибка.
Если макрос остановлен, в том числе из-за ошибки, до выполнения Application.EnableEvents = True, то, так как до этого мы запретили обработку событий, макрос события изменения на листе запущен не будет. Чтобы вернуть обработку нужно добавить небольшой макрос
Код
Sub SetEnableEvents()
    Application.EnableEvents = True
End Sub
и запустить его. Можно еще закрыть Excel и открыть заново.
Чтобы исключить ошибку при очистке всех четырех значений в столбцах C:F надо в строке 13 добавить проверку:
Код
If Not IsEmpty(Range("A" & Target1.Row)) Then Range("A" & Target1.Row) = Left(Range("A" & Target1.Row), Len(Range("A" & Target1.Row)) - 2)
 
А теперь и ошибки нет и не работает путем. Если долго клацать, то какие-то изменения в Столбце А происходят иногда...
Но первоначальная задумка была другая. Может слишком сложная была задача и ей пока что нет решения с помощью vba?
Страницы: 1
Наверх