Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование с автоопределением диапазона
 
#1
26.02.2021 16:59:17
Добрый день.
Подскажите, как можно сделать, что б диапазон копирование выбирался сам, по условию что в ячейках А12:А есть текст.
Код
Sub Кабельный_журнал()

Worksheets("0,4кВ").Range("E12:E105").Copy
Worksheets("кабельний журнал").Range("A7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("C12:C105").Copy
Worksheets("кабельний журнал").Range("B7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("F12:F105").Copy
Worksheets("кабельний журнал").Range("C7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("AO12:AO105").Copy
Worksheets("кабельний журнал").Range("D7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("AN12:AN105").Copy
Worksheets("кабельний журнал").Range("E7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("O12:O105").Copy
Worksheets("кабельний журнал").Range("H7").PasteSpecial Paste:=xlPasteValues

Worksheets("0,4кВ").Range("I12:I105").Copy
Worksheets("кабельний журнал").Range("N7").PasteSpecial Paste:=xlPasteValues

End Sub
 
 
 
#2
26.02.2021 17:36:47
Дмитрий,
А где пример?
 
 
 
#3
26.02.2021 17:44:40
А меня интересует еще вот что: текст должен быть во всех ячейках от А12 до А105? Или как раз и надо копировать только те строки, напротив которых в А есть какое-то значение? Если именно построчно(что скорее всего) - то вот такое ненавязчивое решение:
Код
Sub Кабельный_журнал()
    Dim lr As Long, lcnt As Long, ac As Long
    
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    lcnt = 7
    For lr = 12 To 105
        With Worksheets("0,4кВ")
            If .Cells(lr, 1).Value <> "" Then
                Worksheets("кабельний журнал").Range("A" & lcnt).Value = .Range("E" & lr).Value
                Worksheets("кабельний журнал").Range("B" & lcnt).Value = .Range("C" & lr).Value
                Worksheets("кабельний журнал").Range("C" & lcnt).Value = .Range("F" & lr).Value
                Worksheets("кабельний журнал").Range("D" & lcnt).Value = .Range("AO" & lr).Value
                Worksheets("кабельний журнал").Range("E" & lcnt).Value = .Range("AN" & lr).Value
                Worksheets("кабельний журнал").Range("H" & lcnt).Value = .Range("O" & lr).Value
                Worksheets("кабельний журнал").Range("N" & lcnt).Value = .Range("I" & lr).Value
                lcnt = lcnt + 1
            End If
        End With
    Next
    Application.Calculation = ac
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
26.02.2021 17:47:21
Дмитрий(The_Prist) Щербаков, диапазон от 12 до 105 я прописывал вручную. Но количество строк меняется часто. И от что б не прописывать каждый раз новый дипазон, я обратился сюда к грамотным людям)  
 
 
 
#5
26.02.2021 17:49:33
Дмитрий(The_Prist) Щербаков, Спасибо, я просто увеличил диапазон , и всё работает как мне нужно)
Код
For lr = 12 To 2000
 
 
 
#6
26.02.2021 17:49:38
Цитата
Дмитрий написал:
И от что б не прописывать каждый раз новый дипазон
и вот чтобы не загонять грамотных людей в логический тупик надо расписывать задачу не "как Бог на душу положит", а так, чтобы было понятно не только Вам. Как понять где начинается диапазон? Всегда с 12-ой строки? Дальше как понять где он заканчивается - по последнему значению в столбце А? А если где-то между 1-ой и последней строкой тоже есть пустые ячейки в столбце А - что делать?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
26.02.2021 17:52:19
Дмитрий(The_Prist) Щербаков, прошу прощения за плохо сформулированный вопрос. Всегда начинается с 12 строки, и копирование только если есть данные в столбце А. И всегда вставляется в 7 строку .
 
 
 
#8
26.02.2021 17:57:38
Ну в общем-то подобная задача поднимается с завидной регулярностью - определить последнюю заполненную ячейку :) Как определить последнюю ячейку на листе через VBA?
Код
Sub Кабельный_журнал()
    Dim lr As Long, llastr As Long, lcnt As Long, ac As Long
    
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    lcnt = 7
    With Worksheets("0,4кВ")
        llastr = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lr = 12 To llastr
            If .Cells(lr, 1).Value <> "" Then
                Worksheets("кабельний журнал").Range("A" & lcnt).Value = .Range("E" & lr).Value
                Worksheets("кабельний журнал").Range("B" & lcnt).Value = .Range("C" & lr).Value
                Worksheets("кабельний журнал").Range("C" & lcnt).Value = .Range("F" & lr).Value
                Worksheets("кабельний журнал").Range("D" & lcnt).Value = .Range("AO" & lr).Value
                Worksheets("кабельний журнал").Range("E" & lcnt).Value = .Range("AN" & lr).Value
                Worksheets("кабельний журнал").Range("H" & lcnt).Value = .Range("O" & lr).Value
                Worksheets("кабельний журнал").Range("N" & lcnt).Value = .Range("I" & lr).Value
                lcnt = lcnt + 1
            End If
        Next
    End With
    Application.Calculation = ac
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
26.02.2021 18:00:00
Дмитрий(The_Prist) Щербаков, спасибо за помощь
 
 
 
#10
02.03.2021 09:20:46
Дмитрий(The_Prist) Щербаков, Добрый день. Подскажите, в ваш макрос что вы скинули выше, можно как то сделать, что б вставляемое значение округлялось до второго знака после запятой ?
 
 
 
#11
02.03.2021 09:26:49
Цитата
Дмитрий: можно как то сделать, что б вставляемое значение округлялось до второго знака после запятой ?
можно, но это вопрос не по теме - создайте новую или немного погуглите про округление в VBA
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх