Vba 如果为True，复制其他单元格/如果为False，移动到下一条记录

警告…这个解释有点长

我正在根据单独的工作表结果H列中的故障计数自动填充报告故障报告。故障计数结果是一个countif函数，它根据3列结果D:F中的故障和通过确定故障数，并在另一列结果H列中输出计数

我当前的问题是编写一个嵌套函数或脚本来检查失败计数是否大于零。如果输入失败，则将项目编号结果、列a和描述结果、列B分别复制到失败报告失败报告、列a和列B中，如果输入失败，则不执行任何操作

简言之，我想用项目编号和描述填充故障报告，这些项目仅在故障计数列Results中有故障，列H中有故障，并且在故障报告的条目之间没有空行

更新

我当前的解决方案是对孤立表使用高级筛选器，并按True/False筛选Cols D:F中是否存在通过/失败。我的新问题是创建VBA脚本来复制筛选范围并将其粘贴到失败报告中。我将筛选脚本和复制脚本分开。筛选器脚本工作正常…但复制脚本给我一个错误，说明运行时错误“1004”。提取范围缺少或非法字段名。我对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

---

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

   ------ 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）。尝试编写该循环，如果有任何困难，请返回此处寻求帮助

在没有看到数据的情况下，我无法清楚地了解正在发生的事情。请将以下内容添加到CommandButton1\u单击并告诉我它的作用：

  Dim RngCopy As Range

  Set rngCopy = .SpecialCells(xlCellTypeVisible)

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

---

对任何感兴趣的人来说……我都能让三个宏都成功运行

过滤值宏

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

我知道这三个宏并不完全是流线型的，可能有一些填充可以删除或截断

---

感谢您的帮助，并引导我正确地学习和修改以前的宏。

如果您能分享您迄今为止的尝试，那就更好了。我从您的文本中得知，筛选脚本成功地筛选出了感兴趣的行。我不理解复制脚本。首先，选择结果的A2和B2，然后复制到故障报告。我在结果中看不到任何使用筛选范围的内容。您试图实现什么？筛选器脚本确实按预期工作。复制脚本用于复制结果工作表范围A3:I962中的筛选结果和标题，并将其粘贴到故障报告中。我的

---

d-game是从结果表中筛选出真实值，然后单击一两个启用宏的按钮将这些值粘贴到故障报告中。我在答案中添加了一些代码。请尝试该代码并告诉我它的作用。编译错误：无效或不合格引用。我相信它在分配变量时需要另一个命令…但我是VBA新手，它可能与其他语言（如C或HTML）不同。我已经修改了我的问题，并包含了我正在使用的两个脚本。我让它工作起来了。我不得不稍微调整一下对象。唯一的问题是它现在声明它不能更改合并单元格的一部分…但是脚本可以按需要工作。谢谢你给我指出了正确的方向…然后是一些。