Доброго времени суток. В Экселе есть данные о улицах и домах на этой улице. Дома на каждой улице указаны в одной ячейке через запятую. Подскажите пожалуйста можно ли их разделить автоматически как указал в примере ? Желательно с помощью макроса, потому что такие типовые задачи будут частым явлением
Доброго времени суток. В Экселе есть данные о улицах и домах на этой улице. Дома на каждой улице указаны в одной ячейке через запятую. Подскажите пожалуйста можно ли их разделить автоматически как указал в примере ? Желательно с помощью макроса, потому что такие типовые задачи будут частым явлением pinkvin
Sub u_4() Application.ScreenUpdating = False 'сотрем старую таблицу x = Cells(Rows.Count, "h").End(xlUp).Row If x > 1 Then Range("h2:i" & x).Clear 'составим новую a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка столбца A For b = 2 To a 'цикл от 2 до нижней строки c = Range("b" & b).Value 'значение ячейки столбца B d = Len(c) 'кол-во символов в ячейке e = Len(Replace(c, ",", "")) 'кол-во символов без запятых f = d - e + 1 'кол-во номеров домов g = Range("a" & b).Value 'улица c = c & "," For h = 1 To f 'цикл по кол-ву домов i = InStr(c, ",") 'ищем запятую j = Trim(Left(c, i - 1)) 'дом If IsNumeric(j) = False Then j = "'" & j c = Mid(c, i + 1, d) 'значение ячейки со след. дома k = Cells(Rows.Count, "h").End(xlUp).Row + 1 'строка вставки Range("h" & k) = g Range("i" & k) = j Next Next With Range("h2:i" & k) .Borders.LineStyle = xlContinuous 'границы .HorizontalAlignment = xlCenter 'текс по центру End With Application.ScreenUpdating = True End Sub
[/vba]
макрос [vba]
Код
Sub u_4() Application.ScreenUpdating = False 'сотрем старую таблицу x = Cells(Rows.Count, "h").End(xlUp).Row If x > 1 Then Range("h2:i" & x).Clear 'составим новую a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка столбца A For b = 2 To a 'цикл от 2 до нижней строки c = Range("b" & b).Value 'значение ячейки столбца B d = Len(c) 'кол-во символов в ячейке e = Len(Replace(c, ",", "")) 'кол-во символов без запятых f = d - e + 1 'кол-во номеров домов g = Range("a" & b).Value 'улица c = c & "," For h = 1 To f 'цикл по кол-ву домов i = InStr(c, ",") 'ищем запятую j = Trim(Left(c, i - 1)) 'дом If IsNumeric(j) = False Then j = "'" & j c = Mid(c, i + 1, d) 'значение ячейки со след. дома k = Cells(Rows.Count, "h").End(xlUp).Row + 1 'строка вставки Range("h" & k) = g Range("i" & k) = j Next Next With Range("h2:i" & k) .Borders.LineStyle = xlContinuous 'границы .HorizontalAlignment = xlCenter 'текс по центру End With Application.ScreenUpdating = True End Sub