Создать недостающие артикула для иллюстраций - VBA

Формулировка задачи:

Добрый день! Имеется excel файл, его формат напечатан ниже: Столбец

"A"

- Артикул; Столбец

"B"

- Ссылки на иллюстрации (идут через точку с запятой - ";"). Пример страницы исходник:

"A1"

18172

"B1"

хттп://images.ru/medias/sys_master/root/h57/h96/9027869409310.jpg;хттп://images.ru/medias/sys_master/root/h57/h96/9027869409310.jpg;хттп://images.ru/medias/sys_master/root/h4f/h35/9027869802526.jpg;http://images.ru/medias/sys_master/r...8107672606.jpg

"A2"

338539

"B2"

хттп://images.ru/medias/sys_master/root/hab/h93/8908809502750.jpg;хттп://images.ru/medias/sys_master/root/hab/h93/8908809502750.jpg;хттп://images.ru/medias/sys_master/root/hf0/ha6/8855581917214.jpg

"A3"

450747

"B3"

хттп://images.ru/medias/sys_master/root/h1d/h63/8900317216798.jpg;хттп://images.ru/medias/sys_master/root/h1d/h63/8900317216798.jpg 1. Напишите пожалуйста макрос, который разместит каждую

ссылку на иллюстрацию в отдельную ячейку

, а

рядом с ней в столбце "A" поместит её артикул

; 1.1. Только начиная

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

; 1.2. В оригинальном

файле "исходнике"

таких строк около 50 тыс., то бишь после переноса может быть заполнено около 300 тыс. строк. Пример необходимого результата:

"A1"

18172

"B1"

хттп://images.ru/medias/sys_master/root/h57/h96/9027869409310.jpg

"A2"

18172(1)

"B2"

хттп://images.ru/medias/sys_master/root/h4f/h35/9027869802526.jpg

"A3"

18172(2)

"B3"

хттп://images.ru/medias/sys_master/root/h3a/h31/9027870359582.jpg

"A4"

18172(3)

"B4"

хттп://images.ru/medias/sys_master/root/hbd/h60/9038107672606.jpg

"A5"

338539

"B5"

хттп://images.ru/medias/sys_master/root/hab/h93/8908809502750.jpg

"A6"

338539(1)

"B6"

хттп://images.ru/medias/sys_master/root/hf0/ha6/8855581917214.jpg

"A7"

450747

"B7"

хттп://images.ru/medias/sys_master/root/h1d/h63/8900317216798.jpg P.S. Во вложении прикрепляю два файла: 1. Первый содержит страницы исходник и необходимый результат; 2. Второй содержит 50 тыс. заполненных строк с артикулами и иллюстрациями.

Решение задачи: «Создать недостающие артикула для иллюстраций»

textual
                            Листинг программы 
                        

                            Sub mr()
 
Dim arr() As Variant
Dim datarange As Range
Dim rezrange As Range
Dim ColCount&, RowCount&, NonEmpCount&
Dim i&, j&, rez&, rezCount&, k&
 
RowCount = Sheets("Data").Range("A1").CurrentRegion.Rows.Count
ColCount = Sheets("Data").Range("A1").CurrentRegion.Columns.Count
 
NonEmpCount = Sheets("Data").Range("A1").CurrentRegion.SpecialCells(xlCellTypeConstants).Count
 
Set datarange = Sheets("Data").Range(Sheets("Data").Cells(1, 1), Sheets("Data").Cells(RowCount, ColCount))
 
arr = datarange
 
 
ReDim RezArr(NonEmpCount - RowCount, 2) As Variant
 
rez = 0
 
For i = 1 To UBound(arr)
   j = 3
   
   RezArr(rez, 1) = arr(i, 1)
   RezArr(rez, 2) = arr(i, 2)
   
   rezCount = 1
   rez = rez + 1
   
   For k = 3 To UBound(arr, 2)
  
      If arr(i, k) <> "" Then
        
        RezArr(rez, 1) = arr(i, 1) & "(" & CStr(rezCount) & ")"
        RezArr(rez, 2) = arr(i, k)
        rezCount = rezCount + 1
        'rez = rez + 1
      
      End If
  
   Next k
 
Next i
 
Set rezrange = Sheets("rez").Range(Sheets("rez").Cells(1, 1), Sheets("rez").Cells(NonEmpCount - RowCount, 3))
 
rezrange.Value = RezArr
End Sub
                        