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

时间:2017-01-30 21:57:06

标签: vba excel-vba if-statement excel

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

工作表中有一列"完整视图"命名'更新状态' (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

1 个答案:

答案 0 :(得分:0)

术语“书”让我感到困惑,因为它通常用于工作簿,而不是工作表。我假设你的意思是工作表。此代码在同一工作簿中打开一个新工作表。然后,它检查工作表的C列(“全视图”),检查关键词“新建”,“无变化”和“更新”。如果找到这些单词,则该行col A到Col L将从“Full View”传输到新工作表。

它并不像你的标题那样做,但你可以添加它。

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