0

我正在研究一种基于给定列 (G) 中每一行的值生成列表的方法。目前该列表可以复制整行并完美运行。如果 G 列包含所需的文本（“卡片”），它将拉出所有行，并将它们放在另一个电子表格的列表中，没有间隙。

问题是我希望列表只包含来自每行中包含“卡”的几列的信息，而不是整行。

有没有办法让我的宏只从“A”、“G”和“ET”列中提取信息？

我目前使用的代码如下：

'----Alonso Approved List Generator----'
Sub AlonsoApprovedList()
  Dim cell As Range
  Dim NewRange As Range
  Dim MyCount As Long
  Dim ExistCount As Long
  ExistCount = 0
  MyCount = 1
'----For every cell in row G on the ESI Project Data sheet----'
  For Each cell In Worksheets("ESI Project Data").Range("G6:G5000")
  If cell.Value = "Card" Then
      ExistCount = ExistCount + 1
      If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
      '----Sets up a new range to copy all data from the row if column G in that row contains the value in question----'
      Set NewRange = Application.Union(NewRange, cell.EntireRow)
      MyCount = MyCount + 1
  End If
  Next cell
  If ExistCount > 0 Then
      NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3")
  End If
End Sub

所以简而言之，我想修改上面的代码以从一个工作表中获取数据，并在给定“单元格”范围和特定列的行号的情况下在另一个工作表中生成一个列表。

G 列下拉数据验证列表，其中包含以下项目之一：

卡抵押 汽车零售 商业投资顾问 收款 运营 信息技术 社区事务 人力资源营销 物业执行 财务 风险 征信 员工 管理 RCC

那可能吗？

如果我可以使用 match 函数之类的东西来确定标题使用的列，那就太好了。

澄清一下，这个电子表格由多个不同的用户定期更新，因此信息不是静态的。行添加和更改频繁，偶尔删除。因此，我不能只将原始工作表中的单元格值复制到新列表中。

问题回复：

  1. G 列下拉数据验证列表，其中包含一项。完整列表位于不同的工作表中。用户进入每个行项目并从特定类别中进行选择。
  2. 有问题的其他列包含行项目的名称、类别（与 G 列相同）、货币价值和日期。
  3. 我对上传数据犹豫不决，因为其中大部分是公司信息。我的目标是让宏自动将多个单元格从同一行复制到另一张表。正确行的循环和检测已经存在。基本上，有没有办法用该单元格中的几个选择行替换“cell.EntireRow”（复制整行）？
4

1 回答 1

0

我想回来并用答案更新这个问题。它有点延迟，但回答的问题比永久开放的问题要好......

Sub ApprovedList()

Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy

    arrColsToCopy = Array(1, 3, 4, 5)
    '----For every cell in row G on the ESI Project Data sheet----'
    Set rngDest = Worksheets("Alonso Approved List").Range("A3")

    Application.ScreenUpdating = False

    For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells

        If cell.Value = "Card" Then

            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
                End With
            Next i

            Set rngDest = rngDest.Offset(1, 0) 'next destination row

        End If

    Next cell

    Application.ScreenUpdating = True

End Sub
于 2014-01-04T19:53:41.407 回答