根据另一个工作表 VBA 中的值填充新工作表中的记录

Question

我要做的是仅使用基于另一个工作表上特定列中的某些值的记录来填充新工作表。到目前为止，我已经能够填充整个工作表，而无需仅填充我想要的记录。

工作表“完整视图”中有一个名为“更新状态”（C 列）的列，其值为“无更改”、“已更新”、“新建”、“已关闭”。我只需要在下面填充的新工作表中选择那些记录，其中只有那些在“更新状态”列中具有诸如无更改、已更新、新建等值的记录。但是，当我运行此代码时，它给了我一个空白的工作簿，即使完整视图工作簿中的值具有其他值而不是 C 列中的关闭值。有人可以帮忙吗？ 提前感谢您的帮助！

 Sub Scatterplot()

 Dim headers() As Variant
 Dim ws As Worksheet
 Set ws = Worksheets("Scatterplot Excel Template")

 'Clean Contents
 ws.Cells.ClearContents
 ws.Cells.Interior.ColorIndex = 0

 Sheets("New Risk Template").Range("B3:B4").ClearContents

 'Assign headers
  headers = Array("Record ID", "ID", "Title", "Summary", "Primary Risk     Type", "Secondary Risk Type", _
 "Primary FLU/CF Impacted", "Severity Score", "Likelihood Score", "Structural Risk Factors")

 With ws    
 For I = LBound(headers()) To UBound(headers())
  .Cells(1, 1 + I).Value = headers(I)
  Next I

  Dim book1 As Worksheet
  Dim lookFor As Range
  Set book1 = Worksheets("Full View")
  Set lookFor = book1.Range("B2:X1000")
  Dim row_count As Integer
  Dim col_count As Integer

  'Find the last row and column number
  Dim col_name As String
  Dim record_id As String
  Dim col_index As Integer
  row_count = book1.Range("C" & Rows.Count).End(xlUp).Row

  If book1.Cells(row_count, "C") = "Updated" And book1.Cells(row_count, "C") = "No Change" And book1.Cells(row_count, "C") = "New" Then

  'Loop for input values
  For I = 2 To row_count

  ws.Cells(I, 1).Value = book1.Cells(I + 1, 2).Value
  ws.Cells(I, 2).Value = Right(ws.Cells(I, 1).Value, 4)

  For j = 3 To 10
  On Error Resume Next
  col_name = ws.Cells(1, j)
  record_id = ws.Cells(I, 1)

  col_index = Sheets("Full View").Cells(2, 1).EntireRow.Find  (What:=col_name, _
  LookIn:=xlValues, LookAt:=xlWhole, _
  SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
  MatchCase:=False).Column

  ws.Cells(I, j).Value = Sheets("Full View").Cells(I + 1, col_index).Value
  Next
  Next
  End if

Answer 1

“书”这个词让我很困惑，因为它通常用于工作簿，而不是工作表。我假设您的意思是工作表。此代码在同一工作簿中打开一个新工作表。然后它检查工作表（“完整视图”）的列 C 中的关键字“新”、“无更改”和“已更新”。如果找到这些单词，则从“完整视图”中将行 col A 到 Col L 转移到新工作表。

它不会像你的标题之类的那样做所有事情，但你可以添加它。

Sub tester()
  Dim ws1 As Worksheet, ws2 As Worksheet, lastRowWS1 As Long
  Dim rowCounterWS2 As Long

   Set ws1 = Worksheets("Full View")
    Set ws2 = Sheets.Add(After:=Sheets(Worksheets.Count))
    lastRowWS1 = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Row
    rowCounterWS2 = 2

    For i = 2 To lastRowWS1
        If UCase(ws1.Range("C" & i).Value) = "NEW" Or _
            UCase(ws1.Range("C" & i).Value) = "NO CHANGE" Or _
            UCase(ws1.Range("C" & i).Value) = "UPDATED" Then

            ws2.Range("A" & rowCounterWS2 & ":L" & rowCounterWS2).Value = _
                ws1.Range("A" & i & ":L" & i).Value
            rowCounterWS2 = rowCounterWS2 + 1
        End If
    Next i

End Sub