Excel 使用VBA从主工作表创建动态列表

我正在努力找出下一步需要做什么。在花了很长时间在网上搜索后，我发现下面的代码几乎满足了我的需要

Dim LastRow As Long
LastRow = Worksheets("Data Input").Cells(Rows.Count, "B").End(xlUp).Row
With Worksheets("Sheet7").Range("A3:A" & LastRow)
  Intersect(Worksheets("Data Input").Columns("A:A"), Worksheets("Data Input").Range("A1:A" & LastRow).EntireRow).Copy .Range("A1")
  With .Offset
    .Replace "ARL", "=ARL", xlPart
    On Error Resume Next
    .Offset(1).SpecialCells(xlConstants).EntireRow.Delete
    On Error GoTo 0
    .Replace "=ARL", "ARL", xlPart
  End With
End With
End Sub

我有一个主控表（数据输入），上面的代码搜索a列中的字母“ARL”，并将它们放在表的a列中（表7）。我似乎无法根据A列的搜索结果，找到从多个列输入数据的代码

使用搜索“ARL”找到一行后，我希望代码根据搜索条件将该行上的数据从“数据输入”上的列（a、G、H、Q、R、S、T、U、V、W）传输到“Sheet7”上的列（a-J）。我还想确保在任何选定列中的“数据输入”数据更新或更改时，都会动态执行此操作

---

如果您对在何处查找此问题的答案有任何建议，我们将不胜感激。

请尝试下一个代码。我使用列A:A来确定最后一行。如果需要将其设置为B:B（与原始代码类似），请在

LastRow

获取值的位置对其进行调整：

Sub TESTCopyReplaceDelete()
 Dim LastRow As Long, shD As Worksheet, sh7 As Worksheet

 Set shD = Worksheets("Data Input")
 Set sh7 = Worksheets("Sheet7")
 LastRow = shD.cells(Rows.count, "A").End(xlUp).row

 With sh7.Range("A2:A" & LastRow)
    'shD.Range("A2:W" & LastRow).Copy .Range("A1")'copy all the range and delete the useless columns after
    .Range("A1:W" & LastRow - 1).value = shD.Range("A2:W" & LastRow).value
    .Range("B2:F" & LastRow & ",I2:P" & LastRow).EntireColumn.Delete
    .Replace "ARL", "=ARL", xlPart
    On Error Resume Next
     .SpecialCells(xlConstants).EntireRow.Delete
    On Error GoTo 0
    .Replace "=ARL", "ARL", xlPart
 End With
End Sub

编辑：

请测试下一个版本。它保留前5行，即使A1中的值不是以“ALR”开头，并且适合“Sheet7”中的列宽。我不明白“我仍然有一个页面格式被改变的问题”到底是什么意思。复制范围时，复制数据时页面中的任何内容都不会更改。。。如果希望保持列宽，则不会发生这种情况，因此下一个代码适合列宽：

Sub TESTCopyReplaceDeleteBis()
 Dim LastRow As Long, shD As Worksheet, sh7 As Worksheet
 Dim rng As Range, arr As Variant, i As Long

 Set shD = Worksheets("Data Input")
 Set sh7 = Worksheets("Sheet7")
 LastRow = shD.cells(Rows.count, "A").End(xlUp).row
 
 sh7.Range("A1:W" & LastRow).value = shD.Range("A1:W" & LastRow).value
 sh7.Range("B:F,I:P").EntireColumn.Delete
 sh7.Range("A:J").EntireColumn.AutoFit
 
 With sh7.Range("A6:A" & LastRow)
    .Replace "ARL", "=ARL", xlPart
    On Error Resume Next
     .SpecialCells(xlConstants).EntireRow.Delete
    On Error GoTo 0
    .Replace "=ARL", "ARL", xlPart
 End With
End Sub

---

如果您还需要复制某些格式，请说明。

这是一个糟糕的

Excel

解决方案（但一些

Excel

向导可能会改进它）：

前四个公式用于单元格

A2

，

B2

，

C2

，

D2

：

=IF($N2="","",INDEX('Data Input'!A:A,SUM($N$1:$N2)))
=IF($N2="","",INDEX('Data Input'!G:G,SUM($N$1:$N2)))
=IF($N2="","",INDEX('Data Input'!H:H,SUM($N$1:$N2)))
=IF($N2="","",INDEX('Data Input'!Q:Q,SUM($N$1:$N2)))

现在复制单元格

D2

，直到

J2

以下两个公式转到

N2

和

O2

（可在之后移动）：

---

Intersect（工作表（“数据输入”）.列（“A:A”）、工作表（“数据输入”）.范围（“A1:A”和LastRow）.EntireRow）

正是

工作表（“数据输入”）.范围（“A1:A”和LastRow）

。所以，没有交叉的意义。然后，不带任何行/列参数的

Range.Offset

表示范围本身。为什么您要尝试

。将“ARL”、“=ARL”、xlPart替换两次？删除A:A中没有公式的所有行后，不再使用它。要复制A:A中最后一行的上述列，您必须构建要复制的不连续范围…嗨，FaneDuru，谢谢您的回复。我必须承认，我从网上借用了代码，并试图对其进行调整以使其适用于我，解决了我自己遇到的问题。因此，如果我理解你的意思，我需要用代码
删除以下代码
工作表（“数据输入”）.Range（“A1:A”&LastRow）
。替换“=ARL”、“ARL”、xlPart
，因为每一行的书写方式略有不同
。替换“ARL”、“=ARL”、xlPart
。我没有足够的信心知道在这些方面我能改变什么。你能解释一下你所说的建立一个不连续范围是什么意思吗？我会准备一个答案并在几分钟后发布。。。但是，在此之前，我想澄清下一个问题：为什么
.Offset（1）.SpecialCells（xlConstants）.EntireRow.Delete
？我是说为什么偏移量（1）

？这意味着用一行平移分析的范围。这意味着“A2:A20”将被转换并处理为“A3:A21”。这是你想要的吗？我不否认，如果您想从处理中跳过第二行，这是可能的。我想确定这是您真正想要的…现在，我理解了

的诀窍。替换“ARL”、“=ARL”、xlPart

，然后是

。替换“=ARL”、“ARL”、xlPart

。最初，我忽略了第二次替换，反之亦然……我真正想做的是在主控表上搜索列A以查找特定单词，然后将带有特定列的行数据传输到Sheet7中，并使其动态化，以便在主控表中添加任何信息时，它将始终更新。我一直在考虑索引/匹配的可能性，但似乎无法让它以我想要的方式工作，因为我之前似乎已经读到偏移量比索引/匹配更不稳定。这是可行的，但我现在需要解决一些问题。首先，出于某种原因，表7中的所有列都调整了大小，而不是仅仅在上面传输数据。其次，在母版纸上的G和H列中有以下公式

=IF（ISBLANK（B5），“”，D5&“，”&C5）

&

=IF（ISBLANK（B5），“”，B5）

。为了解决第二个公式的问题，我可以从B列中提取数据，但在第7页的前3列中，显示的顺序必须是A.G，B。@Ian Martin:你没有说任何关于公式的内容。。。您是否需要讨论中的公式，或者复制范围值就足够了？你说的是G&H，你指的是“表格7”还是“数据输入”表格？事实上，这些公式可以在列被处理后自动应用，但我需要知道你上面写的是不是指“Sheet7”。否则，请指定公式引用必须包含的列。换句话说，在“Sheet7”的哪些列中要写入哪个公式…复制范围值sufficient@Ian马丁：如果公式更方便，请指定保留公式的列和公式本身。如果值足够大，并且不需要复制任何格式，我可以使用数组，这将使代码速度非常快，即使是在大范围内。。。那么，你更喜欢什么？@Ian Martin:修改代码以复制值。数组变量…这些公式是否进入表7的单元格？或者这是VBA代码？输入到

表7的单元格中。然后复制下来。@IanMartin：在你上传的工作簿中，当你
=IFERROR(MATCH("ARL",INDIRECT(O2,TRUE),0),"")
=ADDRESS(SUM(N$1:N1)+1,1,4,1,"Data Input")&":"&ADDRESS(1048576,1,4,1)