我要做的是仅使用基于另一个工作表上特定列中某些值的记录来填充新工作表。截至目前,我已经能够填充整个工作表而无需填充我想要的记录。
工作表中有一列"完整视图"命名'更新状态' (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
答案 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