Question

我正在尝试从Sheet1复制特定行，当特定单元格具有状态＆＃34; DONE＆＃34;选择说，以及＆＃34; DONE＆＃34;之后的第二个标准。是检查是否在同一行，另一个单元格也有一个特定的值。之后，复制在特定工作表上找到的行，检查目标是否找到重复项。

到目前为止，我已经设法根据2条标准从Sheet1复制到另一条（旧学校使用IF，我尝试使用autofilter，但我没有设法做到这一点）但我很难防止重复复制到其他工作表。

我尝试了所有的东西，根据带有Range的第一张纸进行值检查，为每张纸写一个宏，这样就可以防止重复，没有任何效果，而且我对此感到困惑。

以下代码的另一个问题是，在多次点击“更新”按钮后，它不会复制所有找到的行，但只会找到第一个行，并且还会在其间插入一些空行而我不会了解原因。

以下是代码：

1- shift the origin to the principal point

2- append to each point in the image plane  1 for the z coordinate 
(which corresponds to a focal length equal to 1): {x,y}  ==> {x,y,1}

3- calculate the angle Thea between {x, y, 1} and the point {0,0,1}

4- calculate the angle Beta in the image plane Beta = ArcTan(y/x)

5- calculate the image rectified coordinates:

      x_rec = x_0 +[ Cos(Beta) * r(Theta)]

     y_rec = y_0 +[ Sin(Beta) * r(Theta)]

Answer 1

我无法测试下面建议的代码，但我相信它可以做你想做的事。

Option Explicit

Private Sub CommandButton1_Click()
    ' 23 Dec 2017

    Dim WsPdi As Worksheet
    Dim WsAtmc As Worksheet, WsCourtesy As Worksheet
    Dim R As Long, Rl As Long               ' row / lastrow "PDI details"

    Set WsPdi = Worksheets("PDI Detail")
    Set WsAtmc = Worksheets("Demo ATMC")
    Set WsCourtesy = Worksheets("Demo ATMC Courtesy")

    Application.ScreenUpdating = False
    With WsPdi
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        For R = 5 To Rl
            If .Cells(R, 20).Value = "DONE" Then
                Select Case .Cells(R, 11).Value
                    Case "ATMC DEMO"
                        TransferData WsPdi, WsAtmc, R
                    Case "ATMC COURTESY"
                        TransferData WsPdi, WsCourtesy, R
                End Select
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub TransferData(WsSource As Worksheet, _
                         WsDest As Worksheet, _
                         R As Long)
    ' 23 Dec 2017

    Dim Csource() As String
    Dim Rn As Long                          ' next empty row in WsDest
    Dim C As Long

    Csource = Split(",A,E,F,G,,H,R", ",")
    With WsDest
        If WsSource.Cells(R, 7).Value <> .Cells(4, "D").Value Then
            Rn = .Cells(.LastRow, "A").End(xlUp).Row + 1
            For C = 1 To 7                      ' columns A to G
                If C <> 5 Then
                    .Cells(Rn, C).Value = WsSource.Cells(R, Csource(C)).Value
                End If
            Next C
        End If
    End With
End Sub

Excel VBA根据条件从一个工作表复制到其他工作表特定单元格

1 个答案: