Каждое второе значение идущее через звёздочку перенести в соседний столбец - VBA
Формулировка задачи:
Добрый день!
Имеется excel файл напечатанного ниже формата:
Столбец "C"
- категория и описание. Примерисходника excel
файла напечатан ниже: [C1] Машина*Красная*Трактор*Серо-коричневый, номер AA88*Телефон в расрочку от 21.03.2016 03:50*Китайский от производителя [C2] Велосипед*Для города*Аэропорт*Новый Напечатайте пожалуйста макрос который каждое второе значение ячейки столбца "C", напечатает в соседней ячейки столбца "D", значения внутри ячейки должны быть разделены * (звёздочкой). Примернеобходимого результата excel
файла напечатан ниже: [C1] Машина*Трактор*Телефон в расрочку от 21.03.2016 03:50 [D1] Красная*Серо-коричневый, номер AA88*Телефон в расрочку от 21.03.2016 03:50*Китайский от производителя [C2] Велосипед*Аэропорт [D2] Для города*Новый Пример excel файла во вложении, в нём представлены страницы исходник и необходимый результат.Решение задачи: «Каждое второе значение идущее через звёздочку перенести в соседний столбец»
textual
Листинг программы
Private Sub Test() Dim iArr, tmp, tmp1$, tmp2$, iRow&, iCount& iArr = Range(Cells(1, 4), Cells(Rows.Count, 3).End(xlUp)).Value For iRow = 1 To UBound(iArr) tmp = Split(iArr(iRow, 1), "*") For iCount = 0 To UBound(tmp) If iCount Mod 2 Then tmp1 = tmp1 & "*" & tmp(iCount) Else tmp2 = tmp2 & "*" & tmp(iCount) End If Next iArr(iRow, 1) = Mid$(tmp2, 2): tmp2 = "" iArr(iRow, 2) = Mid$(tmp1, 2): tmp1 = "" Next Cells(1, 4).Resize(iRow - 1, 2) = iArr End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д