Question

我想知道如何使用＆＃34;工作表 - 更改＆＃34;最好的方式。现在我用它从一个列复制到另一个列，在两个不同的表中。每当Sheet1中的列更新时，Sheet2中的列也将更新。使用两列是没有问题的，代码工作正常！

我的问题是每当我想使用三列时。我想让它循环通过A列，每当它找到单词＆＃34; Orange＆＃34;在其中，它应该将列B复制到sheet2中的coulmn A.请参阅我的表单以获取更多详细信息。

如果它找到橙色，它应该只复制和更新值＆＃34; 1,3,6＆＃34;在B列到表2中的A列。

我试过的代码但没有工作，它将所有内容复制到B列。如果可以使用VLOOKUP，我该怎么做？因为我试过了，但每当细胞被改变时它都没有更新。

Dim x As Range
With Sheets("Sheet1")
Set x = .Columns(1).Find("Orange", LookIn:=xlValues, lookat:=xlWhole)
    If Not x Is Nothing Then
        .Columns(2).Copy Sheets("Sheet2").[B1]
    End If
Set x = Nothing
End With

示例：

练习册1： A栏

橙
苹果
橙
梨
浆果
橙

B栏：

1
2
3
4
5
6

应该填入新的工作表，其中只有＆＃34; 1,3,6＆＃34;粘贴在B栏2中

Answer 1

试试这个：

Sub Fruity()
Application.ScreenUpdating = False
    Dim LastRow As Integer
    'Search code
    LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Dim i As Long


For i = 1 To LastRow

   If ThisWorkbook.Sheets("Sheet1").Range("A" & i) = "Orange" Then
        Set NextCell = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)
        If NextCell = "" Then
            NextCell = ThisWorkbook.Sheets("Sheet1").Range("B" & i)
        Else
            NextCell.Offset(1) = ThisWorkbook.Sheets("Sheet1").Range("B" & i)
        End If
    End If


Next i

Application.ScreenUpdating = True

End Sub

我不确定您的目标是什么用于Worksheet_Change，因此您必须澄清您的问题或自行添加。

* edit：现在将Sheet1中的B列值放入Sheet2中从B1开始的B列，而不是将它们放在与找到的＆＃34; Orange对应的行中。＆＃34;

Answer 2

我认为使用Workbook_SheetDeactivate事件可以更好地为您服务。通过使用此事件（仅当用户选择远离源表的工作表时），您只执行一次复制。作为备用和/或添加，您可以从Workbook_BeforeSave事件执行相同的副本（以防用户保存并退出工作簿而不更改工作表）。

Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Dim activeRange As Range
    Dim lastRow As Long
    Dim c As Range

    If Sh.Name = "Sheet1" Then
        lastRow = Sh.Range("A" & Rows.Count).End(xlUp).Row
        Set activeRange = Sh.Range("A1:A" & lastRow)
        For Each c In activeRange
            If c.Value = "Orange" Then
                Sheets("Sheet2").Range(c.Offset(0, 1).Address) = c.Offset(0, 1).Value
            End If
        Next c
        Debug.Print "done"
    End If
End Sub

如果在三列之间包含特定值，则复制粘贴

2 个答案: