时间戳

首页 > 解决方案 > 设置可见单元格的动态范围

excel - 设置可见单元格的动态范围

问题描述

我有一些代码，我试图根据另一个（主）工作簿中单元格的内容对 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 公式（但这似乎工作正常）。

标签： excelvba

解决方案

尝试...

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

推荐阅读