excel 相关问题

下面是我的excel格式。 KZ 列是所有列的总计 A|B|C|D|E|F|G|H|.....|KZ| 2|4|3|5|5|6|2|7|.....|34| 8|2|3|5|6|6|3|7|.....|44| 2|0|3|5|5|6|2|7|.....|30| 9|4|3|6|5|6|2|7|.....|44|...

excel vba

回答 3 投票 0

宏按钮可将一个电子表格中的某些单元格的信息传输到另一个电子表格中

我希望能够构建一个宏，可以轻松地将单元格内容从一个电子表格传输到另一个电子表格。让我更详细地说明一下：我当前打开了两个电子表格。参见

excel vba

回答 1 投票 0

VBA调用功能

这段代码可以运行，但我需要一种方法来定义变量 x、n 和 c 一次，就像模块范围的变量一样。提供的示例是“调用”许多过程的更大宏的压缩版本。

excel vba

回答 1 投票 0

如何从多个查找值返回多个项目

我正在使用 Excel 2010 中的宏。我有一个名为“DATA”的第一张表，其中有责任规则及其属性。我正在处理 Excel 2010 中的宏。我有一个名为“DATA”的第一张表，其中有带有其属性的责任规则。 <Rule name Source label Criteria etc… until column V RGC-EC-01 AU-DU AUDIT = RGC-EC-01 DU-FICT FICT R RGC-EC-01 NNE-ECC CONTRACT E RGC-EC-02 DU-FICT FICT > RGC-EC-02 LO-DT DIT <> etc… 第二张表名为 OUTCOME。此时除了标题（与数据表相同）之外没有任何数据。此工作表的目的是根据我正在查找的规则名称复制工作表 DATA 中的所有数据。规则名称出现在 W 列（结果表）中，有几个取决于我正在寻找的内容（另一个电子表格不用担心）。我想报告有关 W 列到结果表的值的匹配数据。这就是如何在一个命令中从多个查找值（多个规则（范围单元格））复制多行（一个规则有多行）。例如 W2=RGC-EC-01 W3=RGC-EC-02 我想检索上面列出的所有值等等。我制作了一个数组公式，但它专注于一个值（在本例中为单元格 W2） =IFERROR(INDEX(DATA!A$2:A$7000;SMALL(ROW(DATA!$A$2:$A$7000)*(DATA!$A$2:$A$7000=$W$2);COUNTIF(DATA!$A$2:$A$7000;"<>"&$W$2)+ROW()-1)-1);"") 我将此公式集成到结果表中的单元格 A2 上，然后扩展它以捕获规则名称中的下一个属性（源、标签等...）。它正确地报告了 W2 上存在的规则中的所有行，但正如我所说，我仅限于一个查找值（一条规则）。宏应循环此数组公式，以在 W 列不为空时整合 W 列中的所有值，并将数据复制到结果表上。我已经找了两天了，但由于缺乏VBA技能，我仍然无法成功。欢迎所有帮助！谢谢问候，克里斯如果您想保留数组公式，这就是您想要的： {=IFERROR(INDEX(DATA!A:A,SMALL(IF(COUNTIF($W$2:$W$10,DATA!$A$2:$A$1000),ROW($2:$1000)),ROW()-1)),"")} 编辑我假设您对如何通过 VBA 实现这一目标感兴趣。我将为您提供一个简短的代码，它可以完成您想要的一切。 Sub copyByFilter() With Sheets("DATA") Intersect(.[A:V], .UsedRange).AutoFilter 1, Application.Transpose([OUTCOME!W2:W100]), 7 Intersect(.[A:V], .UsedRange).Copy [OUTCOME!A1] .[A:V].AutoFilter End With End Sub 首先，它使用 Excel 中的内置自动过滤器仅显示符合您条件的值。然后它会复制整个范围并将其粘贴到您的目的地（具有格式并且按照相同的顺序，但没有您不想要的行）。最后一步，它会从“数据”中清除自动过滤器。也就是说：如果您手动使用自动过滤器，那么它会在执行后消失（但您可以再次打开它）。 ;) 没有“循环”/“变量”/“if”或类似的东西。只是少量的功能（按照它们出现的顺序）： Sub With Sheets Intersect []（方括号） UsedRange AutoFilter Application.Transpose* Range.Copy * Application.Transpose还有另一个“奇怪”的行为，可以在here@Jon49的回答中看到。编辑2 如果无法进行自动过滤，那么遍历所有行似乎是不可避免的...我将向您展示如何使用数组公式来实现此目的，例如： COUNTIF(OUTCOME!W2:W***,DATA!A2:A***) 需要将 *** 替换为适当的行号。这是（DATA）： Range("A" & Rows.Count).End(xlUp).Row 如果在 INDEX 中使用，vba 中的 Evaluate 函数可以返回一个数组，该数组会无数次跳过检查每个单元格的部分（这也更快）。把所有的东西放在一起，我们就会得到这样的结果： Sub copyByFilter2() Dim temp As Variant, xList As Range, i As Long, xRows As Long With Sheets("DATA") xRows = .Range("A" & .Rows.Count).End(xlUp).Row temp = Evaluate("INDEX(COUNTIF(OUTCOME!" & Sheets("OUTCOME").Range("W2", Sheets("OUTCOME").Range("W" & .Rows.Count).End(xlUp)).Address & ", DATA!" & .Range("A1:A" & xRows).Address & "),)") Set xList = .Range("A1:V1") For i = 2 To xRows If temp(i, 1) Then Set xList = Union(xList, Intersect(.Range("A:V"), .Rows(i))) Next xList.Copy Sheets("OUTCOME").Cells(1, 1) End With End Sub 因为整个EDIT2都是通过电话完成的，所以可能会有错别字。新函数的链表也将被跳过。如果您还有任何疑问或问题，请询问/告诉我:) 我知道可用于执行此操作的公式是“lookupconcat”归功于他的作者。如果您想忙碌起来，这里有一个 VBA 解决方案。按 ALT + F11 打开 VB 编辑器。在左侧窗口中，找到“VBA Project”下的“This Workbook”，双击它并粘贴以下代码： Option Explicit Sub CopyRules() Dim cell As Object Dim rowLoop As Long Dim ruleLoop As Long Dim writeLoop As Long Dim rulesToFind As Variant Dim rowsToCopy As Variant Dim copyCount As Long 'Get the unique rules in the selected range into a variant array For Each cell In Selection If Len(cell.value) > 0 Then rulesToFind = FncAddtoVariant(rulesToFind, cell.value) End If Next cell 'Get the row numbers that match this criteria into a variant array Do While ruleLoop <= UBound(rulesToFind) 'We start at row #2 because we assume headers in row #1 For rowLoop = 2 To ActiveSheet.UsedRange.Rows.Count If Range("A" & rowLoop).value = rulesToFind(ruleLoop) Then rowsToCopy = FncAddtoVariant(rowsToCopy, CStr(rowLoop)) End If Next rowLoop ruleLoop = ruleLoop + 1 Loop 'Copy the rows to the different sheet For copyCount = 2 To UBound(rowsToCopy) + 2 Sheets("DATA").Select Rows(rowsToCopy(copyCount - 2) & ":" & rowsToCopy(copyCount - 2)).Select Selection.Copy Sheets("OUTCOME").Select Rows(ActiveSheet.UsedRange.Rows.Count + 1 & ":" & ActiveSheet.UsedRange.Rows.Count + 1).Select ActiveSheet.Paste Next copyCount End Sub Private Function FncAddtoVariant(arr As Variant, value As String) As Variant Dim i As Integer If Not FncArrayInitialised(arr) Then ReDim arr(0) i = 0 Else If Not FncPreviouslyAdded(arr, value) Then i = UBound(arr) + 1 ReDim Preserve arr(i) End If End If arr(i) = value FncAddtoVariant = arr End Function Private Function FncArrayInitialised(val) As Boolean On Error GoTo FncArrayInitialisedError Dim i If Not IsArray(val) Then GoTo exitRoutine i = UBound(val) FncArrayInitialised = True exitRoutine: Exit Function FncArrayInitialisedError: Select Case Err.Number Case 9 'Subscript out of range GoTo exitRoutine Case Else Debug.Print Err.Number & ": " & Err.Description, _ "Error in Initialized()" End Select Debug.Assert False Resume End Function Private Function FncPreviouslyAdded(checkArr As Variant, item As String) As Boolean Dim i As Long Dim found As Boolean Do While i <= UBound(checkArr) And found = False If item = checkArr(i) Then found = True i = i + 1 Loop FncPreviouslyAdded = found End Function 然后您应该为此宏分配一个按钮：https://support.microsoft.com/en-gb/kb/141689 完成此操作后，您只需在工作表的“A”列中选择一个范围，然后单击宏按钮，它应该将所有相关列复制到另一个工作表中。

excel vba

回答 3 投票 0

excel 相关问题

最新问题