Question

以下代码可以很好地识别工作表（SOC 5）中的列BH中具有特定值的数据行，并将每个行的列A中的相应值复制到新工作表中。但是，我需要修改代码以仅复制到我的目标表单中的新识别值。意思是，目标表已经有了我正在寻找的一些值。在刷新我的基础数据之后，我需要代码仅提供符合条件的最新值。

Sub Cond5Copy()
'The data is in sheet Data
Sheets("Data").Select
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
For i = 1 To RowCount
    'the qualifying value is in column BH
    Range("BH" & i).Select
    check_value = ActiveCell
    If check_value = "5" Then
        Cells(Application.ActiveCell.Row, 1).Copy
        'The destination set is in sheet SOC 5
        Sheets("SOC 5").Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("Data").Select
    End If
    Next
 End Sub

Answer 1

您可以尝试移动符合以下条件的所有数据：

Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long
Set s = Sheets("Data") 's for Source
Set d = Sheets("SOC 5") 'd for Destination
LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source
For i = 1 to LRs
    If s.Cells( i, "BH") = 5 Then
        LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination
        s.Rows(i).Copy d.Rows(LRd + 1)
    End If
Next i

您可以使用它来验证最新数据：

Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long
Set s = Sheets("Data") 's for Source
Set d = Sheets("SOC 5") 'd for Destination
LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source
LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination
For i = 1 to LRd
    If d.Cells( i, "B") = Application.Index( s.Range( s.Cells(1, "B"), s.Cells(LRs, "B")), Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)) Then
        s.Rows(Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)).Copy d.Rows(i)
    End If
Next i

在A中使用abritrary查找匹配（匹配）和B（索引）的输出。

Answer 2

所以听起来你想要一个独特的值列表。你考虑过使用字典对象吗？ Excel VBA中的字典对象具有一种方法，允许您检查字典中是否已存在值。这使您能够通过检查字典中是否已存在您正在考虑添加到字典中的值来轻松地仅使用唯一值填充字典。

如果这听起来很有意义，那么我建议您访问以下资源，以了解有关如何在VBA中使用词典的更多信息：

https://excelmacromastery.com/vba-dictionary/#A_Quick_Guide_to_the_VBA_Dictionary

您希望使用以下存在方法：

dict.Exists(Key)

检查字典中是否已有值。

如果这个答案不够明确，请告诉我，因为我可以在必要时详细说明。

Answer 3

Sub Cond5CopyNew()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rowCount As Long


Set wsSource = Worksheets("Data")
Set wsDest = Worksheets("SOC 5")


Application.ScreenUpdating = False

With wsSource
    rowCount = .Cells(.Cells.Rows.Count, "a").End(xlUp).Row

    For i = 1 To rowCount
        If .Cells(i, "BH").Value = 5 Then
            'Second check, make sure it's not already copied
            If WorksheetFunction.CountIf(wsDest.Range("A:A"), .Cells(i, "A").Value) = 0 Then
                'Copy the row over to next blank row
                .Cells(i, "A").Copy wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End If
        End If
    Next i
End With

Application.ScreenUpdating = True

End Sub

仅复制新值的附加条件

3 个答案: