Question

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

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

有没有办法让我的宏只从“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

这可能吗？

如果我可以使用匹配函数之类的东西来确定标题所使用的列，那将是非常好的。

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

问题回复：

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

Answer 1

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

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

根据另一个范围的行号向一个范围添加值

1 个答案: