【问题标题】:Filter, Copy and Paste Loop with Non Constant Column Location in VBA在 VBA 中使用非恒定列位置过滤、复制和粘贴循环
【发布时间】:2018-12-12 18:43:53
【问题描述】:

我正在寻求一些帮助,将一些代码放在 VBA 中,这些代码将过滤具有特定标题名称的列,将该信息复制并粘贴到第二张工作表中,然后执行相同的过滤、复制、粘贴操作列中的每个值。不幸的是,该列并不总是在同一个位置。

任何帮助将不胜感激。

以下是我目前得到的:

Dim lastrow As Long
Dim lastcol As Long
Dim SSheet As Worksheet
Dim DSheet As Worksheet
Dim PRange As Range

'Define Data Range
Set SSheet = Worksheets("All Data")
Set DSheet = Worksheets("Data")
lastrow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(lastrow, lastcol)

SSheet.Select
Selection.AutoFilter.Sort.SortFields.Clear
ActiveSheet.ShowAllData
Rows("1:1").Select
Selection.Find(What:="Job Group", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.Range("$A$1:" & lastrow, lastcol).AutoFilter Field:=14, Criteria1:= _"1A"
Cell ("A1").Select
Range("$A$1:" & lastrow, lastcol).Select
Selection.Copy
DSheet.Select
Range("A1").Select
ActiveCell.Paste
Application.CutCopyMode = False

【问题讨论】:

标签: excel vba loops copy-paste


【解决方案1】:
Sub Button1_Click()
    Dim lastrow As Long
    Dim lastcol As Long
    Dim SSheet As Worksheet, Lst As Long
    Dim DSheet As Worksheet
    Dim PRange As Range, fRng As Range, f As String, c As Range

    f = "Job Group"

    Set SSheet = Worksheets("All Data")
    Set DSheet = Worksheets("Data")

    With SSheet
        Lst = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

        With DSheet
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set fRng = .Range(.Cells(1, 1), .Cells(1, lastcol))
            Set c = fRng.Find(what:=f, lookat:=xlWhole)
            Set PRange = .Cells(1, 1).Resize(lastrow, lastcol)
            If .AutoFilterMode Then
                .AutoFilter.Sort.SortFields.Clear
                .AutoFilterMode = False
            End If
            .Range("A1").AutoFilter Field:=c.Column, Criteria1:="1A"
        End With

        PRange.Offset(1).Copy .Cells(Lst, "A")
    End With
End Sub

【讨论】:

  • 当代码到达 If 末尾时,我收到一个错误,即未设置变量。另外,我不认为这当前设置为循环并为过滤列中的所有值执行复制粘贴,这确实是我希望对代码执行的操作。
  • 我向你保证,我不会在没有自己测试的情况下提供代码。你肯定缺少一些信息。
  • @MikeChilders 如果您在.Range("A1").AutoFilter Field:=c.Column, Criteria1:="1A" 行收到“运行时错误'91':对象变量或未设置块变量”,那么它可能意味着c Is Nothing - 这意味着f ("Job Group") 的值在 fRange(“数据”工作表的第 1 行)中找不到 - 但是,问题中的代码表明我们应该搜索“所有数据”表改为:Set fRng = sSheet.Range(sSheet.Cells(1, 1), sSheet.Cells(1, lastcol)) - 这就是为什么在问题中提供示例数据非常有用!
猜你喜欢
  • 2015-12-02
  • 1970-01-01
  • 2019-05-20
  • 2019-01-23
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2020-08-10
相关资源
最近更新 更多