Страницы: 1
RSS
Использование переменной для выбора диапазона
 
Здравствуйте, столкнулся с такой проблемой:
Не получается с помощью переменных указать диапазон для копирования

Код
Dim WB1 As Workbook, WB2 As Workbook
Set WB1 = ActiveWorkbook

Sheets("CRRATYLV").AutoFilterMode = False

    WB1.Sheets("CRRATYLV").Select
    Set WB2 = Workbooks.Add
'    Set WB2 = ActiveWorkbook
    Worksheets(1).Name = "DATA"
    WB1.Activate

Dim PNf As Range, PrN As Long, Fcoll As String
    With Worksheets("CRRATYLV").Rows("1:1")
        Set PNf = .Find(What:="Produkta nosaukums", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not PNf Is Nothing Then
            PrN = PNf.Column
            End If
    End With
    Set PNf = Nothing
    Fcoll = Split(Cells(1, PrN).Address, "$")(1)' Когда указываю диапазон с переменными, пишет что Object doesn't support this property or method
    Columns(Fcoll & ":" & Fcoll).Copy Destination:=WB2.Range("A1")
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
а файл-пример - можно? Макрос-то Ваш я вижу, а вот ваши данные, которые Вы собираетесь копировать, - нет.
 
Здравствуйте.
Может, проще будет
Код
Range(columns(Prn)).Copy


И обязательно ли копировать весь столбец? Может в этом столбце взять диапазон какой-то (например, заполненные его строки) и только этот диапазон копировать?
Кому решение нужно - тот пример и рисует.
 
Есть файл, в котором очень много коллонок, нужно сделать Pivot Table, но все коллонки не нужны, нужны только некоторые. Поэтому, чтобы конечный файл не был огромным и Pivot не зависал, нужные коллонки выгружаю в отдельную Книгу, с которой позже работаю.
Попробовал сделать предыдущий пример Range(columns(Prn)).Copy , ошибка осталась та же.

Сделал пример файла.
 
Цитата
но все коллонки не нужны
Так загружайте в сводную только нужные колонки
 
Напишите макрос, который на листе исходных данных переставит нужные столбы влево, а ненужные вправо.
Исходными данными для сводной таблицы будут только левые столбы и комп меньше будет виснуть.
Изменено: anvas - 15.06.2015 16:46:51
 
Мне всеравно надо делать сводную таблицу в новом файле, так как нет смысла держать все коллонки. Там около 100 коллонок, нужны только 10 из них. При 100 коллонках вес файла будет в районе 100мб, при 10 будет значительно меньше.
 
Потренировался на своём примере.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Дописал код в Вашем примере, вставил примечания - что непонятно - велкам спрашивать! :)
Кому решение нужно - тот пример и рисует.
 
Пытливый, Спасибо за помощь! Все работает. А то часто сталкиваюсь с этой проблемой, когда указываю Range через переменные. Тогда чтобы добавить еще коллонки, просто скопировать и вставить код и изменить what find?

А можно ли как-то вынести в массив find what и сделать конструкцию для этого через For? для того, чтобы код не выглядил громозким
Изменено: alessandro2981 - 16.06.2015 09:04:45
 
Сделал то, что хотел  :)
Теперь чтобы добавить нужные коллонки нужно всего лишь добавить Названия коллонок в массив. Спасибо всем за помощь!
Код
Dim WB1 As Workbook, WB2 As Workbook
Set WB1 = ActiveWorkbook

Sheets("CRRATYLV").AutoFilterMode = False

    WB1.Sheets("CRRATYLV").Select
    Set WB2 = Workbooks.Add
'    Set WB2 = ActiveWorkbook
    Worksheets(1).Name = "DATA"
    WB1.Activate
'Dim LastrowCR As Long
'LastrowCR = WB1.Worksheets("CRRATYLV").Range("A" & Rows.Count).End(xlUp).Row
Dim Nname() As Variant
Dim xy As Long
Dim yx As Integer
Nname = Array("Produkta nosaukums", "Polišu izdevēji")
yx = UBound(Nname, 1)
For xy = 0 To yx

'    Produkta nosaukums
Dim PNf As Range, PrN As Long, Fcoll As String
    With Worksheets("CRRATYLV").Rows("1:1")
        Set PNf = .Find(What:=Nname(xy), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not PNf Is Nothing Then
            PrN = PNf.Column
            End If
    End With
    Set PNf = Nothing
    lngI = Cells(Rows.Count, PrN).End(xlUp).Row
    Range(Cells(1, PrN), Cells(lngI, PrN)).Copy
    WB2.Worksheets("DATA").Cells(1, xy + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Next xy
End
Страницы: 1
Читают тему
Наверх