Question

警告......这个解释有点长

我正在根据单独工作表中的失败计数自动填充报告（失败报告）（结果，Col H）。故障计数（结果）是一个countif函数，用于确定3列（结果，D：F）范围内的故障数（基于Fail和Pass），并在另一列中输出计数（Results，Col H）。

我目前的问题是编写嵌套函数或脚本，以检查失败计数是否大于零。如果为True（已输入＆＃34;失败＆＃34;输入），则将项目编号（结果，col A）和描述（结果，Col B）分别复制到故障报告（故障报告，Col A和B）中如果它是假的（并且已经输入了＃34; pass＆＃34;）并且什么都不做。

简而言之...我想用仅项目编号和描述填充失败报告，其中包含＆＃34;失败＆＃34;在故障计数列（结果，列H）中，故障报告中的条目之间没有空行。

更新

我目前的解决方案是对单独的表使用高级过滤器并按True / False过滤（在Cols D：F中是否存在通过/失败）。我的新问题是创建一个VBA脚本来复制过滤后的范围并将其粘贴到失败报告中。我将过滤器和复制脚本分开。过滤器脚本工作正常......但是复制脚本给我一个错误，说明＆＃34;运行时错误＆＃39; 1004＆＃39;提取范围具有缺失或非法的字段名称。＆＃34;我对Excel很有经验，但随着我的进步，我正在学习VB / VBA。

过滤脚本

Sub Button2_Click()
'PURPOSE: Filter on specific values


Dim rng As Range

Set rng = ActiveSheet.Range("A3:I962")
FilterField = WorksheetFunction.Match("False", rng.Rows(1), 0)

'Turn on filter if not already turned on
 If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

'Filter Specific values
 rng.AutoFilter Field:=FilterField, Criteria1:=Array( _
"False"), Operator:=xlFilterValues



End Sub

复制脚本

Sub CommandButton1_Click()

'Dim rng As Range

'Set rng = ActiveSheet.Range("A3:I962")

Sheets("Results").Select
Sheets("Results").Range("A2,B2").Select
Selection.Copy
Sheets("Failure Report").Select
Sheets("Failure Report").Range("I21:J21").PasteSpecial
'Columns("K:K").EntireColumn.AutoFit
'Columns("L:L").EntireColumn.AutoFit
'Sheets("Failure Report").Range("Z4").Select
Sheets("Results").Select
Application.CutCopyMode = False
Range("J34").Select
Sheets("Failure Report").Activate
Sheets("Results").Range("A3:I962").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Results").Range("J1:J2"), _
CopyToRange:=Sheets("Failure Report").Range("I22:J22"), Unique:=True
Selection.PasteSpecial

End Sub

Answer 1

这不是答案。它试图从你的文本中提取重要的事实。

   ------ Sheet3 ------       Another sheet (?)
   D   E   F      G/H         X     Y
  xxx xxx xxx      a          if a>0 then values from columns A and B else no entry for row
  xxx xxx xxx      b          if b>0 then values from columns A and B else no entry for row
  xxx xxx xxx      c          if c>0 then values from columns A and B else no entry for row
                              if d>0 then values from columns A and B else no entry for row
  xxx xxx xxx      d

  Formulae      Failure
 summarising     counts
 information    derived
from elsewhere  from D:F

你有32张桌子。这些表的数量，它们在另一个工作表中的位置以及它们在三个工作表中的先前位置与此问题无关。

表3的列D：F包含总结32个表中信息的公式。在我的“图表”中，我已经说过“其他地方”，因为这些公式的性质和源数据的位置无关。这些列可以包含空格。 “xxx”可以是“通过”或“失败”。

在第1段和第2段中，您说H列包含失败计数。在第4段中，您说它是G列。无论哪一列，它都包含D：F列中“失败”数的计数，因此该值可以是0,1,2或3.因为列中存在间隙D：F，G / H栏中有间隙。

我不知道列X和Y的位置，但它们是您要填充的列。如果列G / H大于零，则将工作表3的A列和B列复制到X和Y列。与其他列不同，这些列中没有间隙。在G / H列中为零或如果为空，则不会将任何内容复制到X和Y列。

以上是我尝试从您的文字中挑逗您的要求。我怀疑它可以进一步减少，因为我不认为D：F列是相关的。你有A，B和G / H列。 G / H列可以包含0,1,2,3或空白。如果列G / H的值为1.2或3，则将颜色A和B复制到列X和Y.对于列G / H为0或空白的行，列X和Y不应为空行。

您应该修改您的问题，使其仅包含相关信息。

我使用VBA作为一种方便的编程语言;我不是Excel及其公式的专家。我不相信您可以通过公式实现您的目标，但如果您的问题是明确的并且仅限于相关信息，Excel专家可能会回答解决方案。

在VBA中，这将是一个简单的循环，它会向下运行G / H列并复制数据（如果它是1,2或3）。如果您遇到任何困难，请转到编码循环然后返回此处寻求帮助。< / p>

如果没有看到数据，我就无法清楚地知道发生了什么。请将以下内容添加到CommandButton1_Click的顶部并告诉我它的作用：

  Dim RngCopy As Range

  Set rngCopy = .SpecialCells(xlCellTypeVisible)

  RngCopy.Copy Destination:=Sheets("Failure Report").Range("A21")

Answer 2

对于任何有兴趣的人......我能够让宏（所有这三个）成功运作。

过滤值宏

Sub FilterValues()
'PURPOSE: Filter on specific values

 Dim rng As Range

 Set rng = Sheets("Results").Range("A3:J962")
 FilterField = WorksheetFunction.Match("False", rng.Rows(1), 0)

 'Turn on filter if not already turned on
  If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

 'Filter Specific values
  rng.AutoFilter Field:=FilterField, Criteria1:=Array( _
  "False"), Operator:=xlFilterValues    

End Sub

复制高级排序表的值

Sub CopyValues()

 'Declare Variables
  Dim rngCopy As Range
  Dim rngCopyNotes As Range

 'Set Variables
  Set rngCopy = Sheets("Results").Range("A3:B962").SpecialCells(xlCellTypeVisible)
  Set rngCopyNotes = Sheets("Results").Range("I3:J962").SpecialCells(xlCellTypeVisible)

 'Set destination for variables
  rngCopy.Copy Destination:=Sheets("Failure Report").Range("A22")
  rngCopyNotes.Copy Destination:=Sheets("Failure Report").Range("H22")

 'Copy headers and values
  Sheets("Results").Activate
  Sheets("Results").Range("A2:B2").Select
  Selection.Copy
  Sheets("Failure Report").Select
  Sheets("Failure Report").Range("A21:B21").PasteSpecial

  Sheets("Results").Activate
  Sheets("Results").Range("J2,I2").Select
  Selection.Copy
  Sheets("Failure Report").Select
  Sheets("Failure Report").Range("H21:I21").PasteSpecial

 'Autofit columns A through H
 'Columns("A:H").EntireColumn.AutoFit

  Sheets("Failure Report").Range("F12").Select
  Sheets("Results").Activate
  Application.CutCopyMode = False
  Range("N34").Select
  Sheets("Failure Report").Activate

End Sub

自动换行

Sub WordWrap()

 ' WordWrap Macro

 Sheets("Failure Report").Activate
 Columns("I:I").Select
 With Selection
     .HorizontalAlignment = xlGeneral
     .WrapText = True
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
     .MergeCells = False
 End With


 Columns("B:B").Select
 With Selection
     .HorizontalAlignment = xlGeneral
     .WrapText = True
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
     .MergeCells = False
 End With
End Sub

我知道这三个宏并不完全精简，可能会有一些填充物被删除或截断。

感谢您的帮助，并指导我正确的方向来学习和调整我以前的宏。

如果为True，则复制其他单元格/ IF False，移至下一条记录

2 个答案: