Question

我多年没有编码，所以尽力传达我的目标。

我有一张主表，其中包含许多项目的列表（在主人名单中列出了他们自己的单元格），这些项目同样有自己的编号表。此Master具有与行中所有其他项目相关的信息，在相应单元格下选择时，将该行信息复制到适用项目表中的下一个可用行。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim nextrow As Long, lastrow As Long, i As Long

nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet5.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet6.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet7.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet8.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet9.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet10.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet11.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet12.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet13.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet14.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet15.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet16.Cells(Rows.Count, "A").End(xlUp).Row + 1
nextrow = Sheet17.Cells(Rows.Count, "A").End(xlUp).Row + 1
lastrow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row + 1

If Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

If Not Intersect(Target, Range("C5:C" & lastrow)) Is Nothing Then
    If Target <> vbNullString Then
        i = Target.Row
        Range("A" & i & ":B" & i).Copy Destination:=Sheet1.Range("A" & nextrow)
    End If
End If

对于每个工作表编号重复前6行代码，直到它到达最后一个工作表（工作表17和单元格Q），然后是：

 Application.ScreenUpdating = True
end Sub

这有效，但是当它复制信息时，它会替换现有信息，而不是将其放在下一个可用行中。无论上一个项目表是什么，都是例外情况。最后一张纸按预期工作。

Answer 1

只是您在开始时进行的每次计算中都覆盖 nextrow = Sheet17.Cells(Rows.Count, "A").End(xlUp).Row + 1，因此您只有事实Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False Dim nextrow As Long, lastrow As Long, i As Long lastrow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row + 1 nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1 If Not Intersect(Target, Range("C5:C" & lastrow)) Is Nothing Then If Target <> vbNullString Then i = Target.Row Range("A" & i & ":B" & i).Copy Destination:=Sheet1.Range("A" & nextrow) End If End If nextrow = Sheet5.Cells(Rows.Count, "A").End(xlUp).Row + 1 If Not Intersect(Target, Range("C5:C" & lastrow)) Is Nothing Then If Target <> vbNullString Then i = Target.Row Range("A" & i & ":B" & i).Copy Destination:=Sheet5.Range("A" & nextrow) End If End If nextrow = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row + 1 'And so ON....。

你需要改变这样的结构：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False

Dim NextRow As Long, LastRow As Long, i As Long, Sh() As Variant, Ws As Worksheet
LastRow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row + 1

ReDim Sh(1 To 15, 1 To 2)
Set Sh(1, 1) = Sheet1:      Sh(1, 2) = "C5:C"
Set Sh(2, 1) = Sheet5:      Sh(2, 2) = "D5:D"
Set Sh(3, 1) = Sheet4:      Sh(3, 2) = "E5:E"
Set Sh(4, 1) = Sheet6:      Sh(4, 2) = "F5:F"
Set Sh(5, 1) = Sheet7:      Sh(5, 2) = "G5:G"
Set Sh(6, 1) = Sheet8:      Sh(6, 2) = "H5:H"
Set Sh(7, 1) = sheet9:      Sh(7, 2) = "I5:I"
Set Sh(8, 1) = sheet10:     Sh(8, 2) = "J5:J"
Set Sh(9, 1) = sheet11:     Sh(9, 2) = "K5:K"
Set Sh(10, 1) = sheet12:    Sh(10, 2) = "L5:L"
Set Sh(11, 1) = sheet13:    Sh(11, 2) = "M5:M"
Set Sh(12, 1) = Sheet14:    Sh(12, 2) = "N5:N"
Set Sh(13, 1) = Sheet15:    Sh(13, 2) = "O5:O"
Set Sh(14, 1) = sheet16:    Sh(14, 2) = "P5:P"
Set Sh(15, 1) = Sheet17:    Sh(15, 2) = "Q5:Q"

For k = LBound(Sh, 1) To UBound(Sh, 1)
    Set Ws = Sh(k, 1)
    NextRow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    If Not Intersect(Target, Range(Sh(k, 2) & LastRow)) Is Nothing Then
        If Target <> vbNullString Then
            i = Target.Row
            Range("A" & i & ":B" & i).Copy Destination:=Ws.Range("A" & NextRow)
        End If
    End If
Next k

Application.ScreenUpdating = True
End Sub

或者使用工作表数组＆＃39;对象：

SELECT  T1.T1USERID, T1.T1USER, T1.T1badge, T2.CC
INTO    NewTable_NoCC
FROM    T1 
        LEFT JOIN T2 ON T1.T1BADGE IN (T2.NEW_ID, T2.OLDBADGE)
WHERE   T2.CC IS NULL

根据单元格输入将行信息从一个工作表复制到另一个工作表

1 个答案: