如果列A包含文本且列G为空，则将行复制到新电子表格

Question

我正在尝试为下游应用程序中的人员创建一个摘要列表，以便为我的几台生产计算机提供数据。每台机器都有自己的标签来请求材料，我希望所有的请求都在一个标签上进行汇总（称为“Core_Cutter_List”）。

所以基本上我正在尝试创建一个VBA，它将电子表格“2”中的一行复制到电子表格“Core_Cutter_List”的下一个空白行。如果A列中有文本且G列为空白，我希望它复制。我对VBA知之甚少。我找到的代码只能测试我的一个标准，即G列是空白的，但基本上它遍历我文件中的每个单元格。你知道我如何添加其中包含文本的A列的其他标准，以便它不会查看我工作表上的每个单元格吗？谢谢你的帮助！

auto

Answer 1

如果您需要两个条件，那么您应该使用IF在And语句中仔细撰写：

像If cell.Value = "" And Len(cell.Offset(0,-6)) Then这样的东西应该可行。

使用Select有点不可取，但它起初有用 - How to avoid using Select in Excel VBA

Answer 2

Sub bellow执行以下操作

• 根据A列中的值确定工作表中的最后一行（＆＃34; 2＆＃34;）
• 根据第1行中的值确定工作表中最后使用的col（＆＃34; 2＆＃34;）
• 根据A列中的值确定工作表中最后使用的行（＆＃34; Core_Cutter_List＆＃34;）
• 遍历工作表中所有已使用的行（＆＃34; 2＆＃34;）
  • 如果col A中的单元格不为空，则col G中的单元格为空
    • 将整行复制到工作表中的下一个空行（＆＃34; Core_Cutter_List＆＃34;）
    • 为工作表增加下一个空行（＆＃34; Core_Cutter_List＆＃34;）
  • 循环到工作表中的下一个使用的行（＆＃34; 2＆＃34;）

Option Explicit

Public Sub CopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
    Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long

    Set ws1 = ThisWorkbook.Worksheets("2")
    Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")

    ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row        'last row in "2"
    ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
    ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1    'last row in "Core_Cutter"

    For i = 1 To ws1lr

        If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then

            Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
            Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))

            ws2r.Value2 = ws1r.Value2
            ws2lr = ws2lr + 1
        End If

    Next i

End Sub

我的测试文件

工作表（＆＃34; 2＆＃34）

工作表（＆＃34; Core_Cutter_List＆＃34）