установить динамический диапазон из видимых ячеек - PullRequest
0 голосов
/ 19 февраля 2019

У меня есть код, в котором я пытаюсь отсортировать набор данных в CSV-файле на основе содержимого ячейки в другой (основной) книге.Затем на основе этого вида скопируйте диапазон видимых ячеек между первым и шестым столбцами, но с динамической последней строкой, таким образом, диапазон будет динамическим.Затем этот динамический диапазон вставляется в основной лист, что затем позволяет мне продолжить работу с этим набором данных.

Не получается заставить работать сортировку или работать с динамическим диапазоном.Я попробовал всевозможные варианты приведенного ниже кода и ищу вдохновение.

Sub Get_OA_Data()

'Find OA data from source SQL file and copy into serial number generator 
Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'This section sets the workbooks and worksheets to be used for this macro
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
Set rng2 = ws.Range("F6")

'   This line deletes any content of the cannot assign serial number added previously
ws.Range("I6:I7").ClearContents

'This hides all rows which do not match the desired OA number (found in rng2)
For Each Cell In ws2.Range("A1").End(xlDown)
    If Left(Cell.Value, 6) <> rng2.Value Then
        Cell.EntireRow.Hidden = True
    End If
Next Cell

Set StartCell = ws2.Range("A1")
LastRow = StartCell.SpecialCells(xlCellTypeVisible).Row
LastColumn = StartCell.SpecialCells(xlCellTypeVisible).Column

'This section selects and copies the visible range from csv file into serialisation generator
Set rng = ws2.Range(StartCell.ws2.Cells(LastRow, LastColumn))
    rng.Copy
    ws.Activate
    ws.Range("D12").Select
    Selection.PasteSpecial 'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False     

End Sub

Любая помощь будет принята с благодарностью, я купил пару книг, но ничего из этого вмои книги помогают с этой проблемой.

PS Я использовал очень похожий код с определенными диапазонами наборов, и он работает нормально, но этот меня озадачил.Также может быть проблема с набором данных, поэтому в коде есть формула LEFT (но, похоже, она работает нормально).

1 Ответ

0 голосов
/ 19 февраля 2019

Попробуйте ...

Option Explicit

Sub Get_OA_Data()

Dim wkb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, xCell As Range
Dim LR As Long, LC As Long, LR2 As Long

Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")

ws.Range("I6:I7").ClearContents
LR2 = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row

For Each xCell In ws2.Range("A1:A" & LR2)
    xCell.EntireRow.Hidden = Left(xCell.Value, 6) <> ws.Range("F6")
Next xCell

LR = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
LC = ws2.Cells(1, ws.Columns.Count).End(xlToLeft).Column

Set rng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(LR, LC))
    rng.SpecialCells(xlCellTypeVisible).Copy
    ws2.Range("D12").PasteSpecial xlPasteValues

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...