Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для копирования каждой 14-й ячейки в колонке
 
#1
17.08.2019 17:21:26
Уважаемые коллеги, помогите решить задачку..

Нужно написать макрос для копирования каждой 14-й ячейки в колонке А листа "List" и вставить на лист "Worksheet"

Путем редактирования записаного макроса удалось получить такой результат
Код
Sheets("List").Select
 Range("A2,A16,A30,A44,A58,A72,A86,A100,A114,A128,A142,A156,A170,A184,A198,A212,A226,A240,A254,A268,A282,A296,A310,A324,   A338,A352,A366,A380,A394,A408,A422,A436,A450,A464,A478,A492,A506,A520,A534,A548,A562,A576").Select
    Range("A576").Activate
    Selection.Copy
    Sheets("Worksheet").Select
    Range("A2").Select
    ActiveSheet.Paste
Оно то работает , но мне нужно скопировать гораздо больше ячеек, а писать в ручную долго .  Может быть есть другой подход ?
 
 
 
 
#2
17.08.2019 17:26:05
Цитата
axill_3d написал:
есть другой подход
есть - файл в студию, а по фотке (не оптимизировал):
Код
Sub g()
    For i = 2 To 100500 Step 14
        Sheets("Worksheet").Cells(i, 1) = Sheets("List").Cells(i, 1)
    Next i
End Sub
Изменено: buchlotnik - 17.08.2019 17:35:13
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#3
17.08.2019 17:41:43
С листа "List" из колонки А начиная со второй ячейки и интервалом в 14-ть ячеек нужно скопировать данные и поместить их на лист "Worksheet" в колонку А начиная со второй ячейки .

Файл прилагаю  
 
 
 
#4
17.08.2019 17:58:20
Так?
Код
Sub g()
    r = Sheets("List").[A1000000].End(xlUp).Row
    j = 1
    For i = 2 To r Step 14
        j = j + 1
        Sheets("Worksheet").Cells(j, 1) = Sheets("List").Cells(i, 1)
    Next i
End Sub
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#5
17.08.2019 18:06:14
Да работает , только при переносе меняется формат ячейки  
Изменено: axill_3d - 17.08.2019 23:13:55
 
 
 
#6
17.08.2019 18:09:21
Код
Sub g()
    r = Sheets("List").[A1000000].End(xlUp).Row
    j = 1
    For i = 2 To r Step 14
        j = j + 1
        Sheets("Worksheet").Cells(j, 1) = Format(Sheets("List").Cells(i, 1), "dd.MM.YYYY")
    Next i
End Sub
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#7
17.08.2019 18:10:50
Цитата
buchlotnik написал:
r = Sheets("List").[A1000000].End(xlUp).Row    j = 1    For i = 2 To r Step 14        j = j + 1        Sheets("Worksheet").Cells(j, 1) = Format(Sheets("List").Cells(i, 1), "dd.MM.YYYY")    Next i
Вот теперь отлично . Спасибо большое
 
 
 
#8
17.08.2019 18:30:35
Теперь не отлично., плохо... Зачем безумно копируете сообщение?
 
 
 
#9
17.08.2019 20:14:41
вариант в Power Query
Код
let
    Source      =  Excel.CurrentWorkbook(){[Name="List"]}[Content][Column1],
    fn = (_)    => Record.FromList(List.Alternate(_,1,1,0),List.Alternate(_,1,1,1)),
    Records     =  List.Transform(List.Split(Source,14),fn),
    Table       =  Table.FromRecords(Records),
    fn1=(a,b,c) => Number.From(if Value.Is(a,DateTime.Type) then Date.ToText(Date.From(a),"MM,yy") else Text.Replace(a,b,c)),
    Replaced    =  Table.ReplaceValue(Table,".",Text.Range(Text.From(1/2),1,1),fn1,{"Сума загалом в аптеці (грн)","Сума загалом відшкодування (грн)","Сума доплати (грн)"})
in
    Table.TransformColumnTypes(Replaced,{{"Дата погашення", type date}})
Изменено: Андрей Лящук - 17.08.2019 21:03:28 (изменил запрос, заменил файл)
 
 
 
Страницы: 1
Наверх