Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование одного массива в другой с дублированием элементов
 
#1
11.05.2018 15:14:33
Приветствую. При попытках автоматизации своей работы столкнулся с проблемой, которую решить у меня не получается. А именно не могу понять как копировать элементы массива в другой массив с использованием различных алгоритмов.
Сама задача: требуется взять диапазон строк в одном столбце и перенести с удвоением в другой столбец.
Пытался выполнить это через перебор строк и копирования в другой столбец с условием четности и нечетности. Не получилось. Да и не правильно это на мой взгляд.
Стал использовать массивы, но не понимаю как это сделать. Присвоение элементов работает только один ко одному.

Прошу натолкнуть на правильную мысль.
Код
Sub Mas5()
  Dim Arr()
  Dim i As Long, j As Long, b As Long, Lastrow As Long
  Application.ScreenUpdating = 0
  Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  
  Arr = Range(Cells(2, 1), Cells(Lastrow, 1)).Value
  ReDim Arr2(1 To Lastrow*2, 1 To 1)
  
  For i = 1 To Lastrow - 1
     For j = i + 1 To Lastrow
         'я не понимаю как описать алгоритм копирования    
     Next
  Next
  
   Cells(2, 7).Resize(Lastrow, 1).Value = Arr
  
  Application.ScreenUpdating = 1
End Sub
Изменено: isdn - 11.05.2018 17:19:07
 
 
 
#2
11.05.2018 16:44:02
Код
For i = 1 To UBound(ar1)
    ar2(i * 2, 1) = ar1(i, 1)
    ar2(i * 2 - 1, 1) = ar1(i, 1)
Next i
 
 
 
#3
11.05.2018 17:11:53
Цитата
isdn написал:
взять диапазон строк в одном столбце и перенести с удвоением в другой столбец
Код
Option Explicit
Option Base 1

Sub aaa_bbb_bbb_1()
Dim i As Long, vim As Long
Dim tbl()

    vim = Cells(Rows.Count, "a").End(xlUp).Row
    tbl = Range("a2:a" & vim).Value
    vim = vim - 1
    For i = 1 To vim
        tbl(i, 1) = tbl(i, 1) * 2
    Next
    Range("b2").Resize(vim, 1).Value = tbl
End Sub

Sub aaa_bbb_bbb_2()
Dim i As Long, vim As Long

    vim = Cells(Rows.Count, "a").End(xlUp).Row
    Range("b2:b" & vim).Value = Range("a2:a" & vim).Value
    For i = 2 To vim
        Range("b" & i).Value = Range("b" & i).Value * 2
    Next
End Sub
Изменено: ocet p - 11.05.2018 17:18:36
 
 
 
#4
11.05.2018 20:06:06
Привет!
Код
Option Explicit

Public Sub Массив_Удвоить()
    Dim arr_Sour() As Variant, arr_Dest() As Variant

    arr_Sour = [a1].CurrentRegion.Offset(1).Value

    ReDim arr_Dest(1 To UBound(arr_Sour) * 2, 1 To 1)

    Dim x As Long
    For x = LBound(arr_Sour) To UBound(arr_Sour)
        arr_Dest(x * 2 - 1, 1) = arr_Sour(x, 1)
        arr_Dest(x * 2, 1) = arr_Sour(x, 1)
    Next

    [f2].Resize(UBound(arr_Dest), UBound(arr_Dest, 2)) = arr_Dest
End Sub
Сравнение прайсов, таблиц - без настроек
 
 
 
#5
11.05.2018 22:36:25
Код
Sub iInsertArray()
    Dim arr(), i&, j&
    arr = Range([a2], [a1].End(xlDown)).Value
    ReDim iarr(1 To UBound(arr) * 2, 0)
    For i = 1 To UBound(iarr) Step 2
        j = j + 1
        iarr(i, 0) = arr(j, 1)
        iarr(i + 1, 0) = arr(j, 1)
    Next i
    [f2].Resize(UBound(iarr), 2).Value = iarr
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#6
12.05.2018 17:03:09
Огромное спасибо за помощь.  Наконец понял свою ошибку своего алгоритма. :)  
 
 
 
Страницы: 1
Наверх