Question

我希望获得一些帮助，以便在VBA中将数据从一张纸移到另一张纸。我随附了源数据表和目标数据表的屏幕截图，以使事情更容易可视化。

我需要：

Sheet2以在“雇员”列下显示雇员姓名（来自单元格C3）
Pay period列下的A（来自PP列）
B列下的数据（来自production date列）
在E列下执行的活动（来自H-task ID列）
以及它们在How many?列下执行的每个活动的数量。

下面带有0的所有活动都不需要一行，我只需要为实际已完成一定数量的活动添加新行。

源工作表中的其他数据可以忽略。

我唯一需要数据的活动是Mopping, Cleaning, Scrubbing, and Wiping。

我以手动方式进行了几行生产，但是由于我有数百个相似的生产图纸，所以我想找出一种使过程自动化的方法。

我试图自己编写代码（附加），但是它很杂乱，似乎无法正确完成工作：（任何帮助或技巧都将不胜感激:)

源数据：目标表： Destination sheet

Sub Report()
    Dim ws1 as worksheet
    Set ws1 = Sheets("Sheet1")

    Dim ws2 As Worksheet
    Set ws2 = Sheets("Sheet2")

    Dim i As Long
    Dim Roww As Long
    Dim NameRow As Long: NameRow = 1

    Sheets("Sheet2").Range("F2:F2000").Value = "Regular Hours"

    For i = 1 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        If InStr(ws1.Cells(i, "A").Value2, "PP") > 0 Then

            Roww = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 0).Row

        If Not IsError(ws1.Cells(i, "D")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "B").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "C").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "B").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "G")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2


                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "E").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "F").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "E").Value2

                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "J")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "H").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "I").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "H").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "M")) Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2


                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "K").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "L").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "K").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "N")) > 0 Then

                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "N").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "N").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "O")) > 0 Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "O").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "O").Value2

                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "P")) > 0 Then

                'period, name
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                'type, hours
                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "P").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "P").Value2

                'year
                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "Q")) > 0 Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "Q").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "Q").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If

        ElseIf InStr(ws1.Cells(i, "A").Value2, "Name") > 0 Then
            NameRow = i
        End If

    Next i
End Sub

Answer 1

不确定为什么要在F列中添加“常规时间”。

就效率而言，在您所处的环境中有足够的重复操作，您可以使用单独的功能将数据“保存”到目标表中。以下是有关如何简化您情况下的某些逻辑的示例。显然，您需要对其进行修改以适合您的确切需求。

    $firstname = $profile['first_name'];
    $lastname = $profile['last_name'];
    $email = $profile['email'];
    $picture = $profile['picture']['url'];

    try {
        $conn = new PDO("mysql:host=$host;dbname=$dbname", $user, $pass);

        $conn->setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION);
        $stmt = $conn->prepare("
            INSERT INTO users (
                firstname, 
                lastname, 
                email, 
                picture, 
                token
            ) 
            VALUES (
                :firstname, 
                :lastname, 
                :email, 
                :picture, 
                :token)"
            );
        $stmt->bindParam(':firstname', $firstname);
        $stmt->bindParam(':lastname', $lastname);
        $stmt->bindParam(':email', $email);
        $stmt->bindParam(':picture', $picture);
        $stmt->bindParam(':token', $accessToken);

        $stmt->execute();
        echo "Thank you for registering";
    }
    catch(PDOException $e)
    {
        echo "Error: " . $e->getMessage();
    }
    $conn = null;

} else {

    $loginUrl = $helper->getLoginUrl('mywebsite.com/fblogin/index.php', $permissions);
    echo '<a href="' . $loginUrl . '">Log in with Facebook!</a>';
}

Answer 2

我并未囊括所有内容，因为您似乎已经知道如何获取数据范围，因此我将它们保留了测试值。也没有包括您正在传递的所有字段，因为您似乎对此有所了解。

主要区别是在标题行中扫描您的姓名。该代码的作用是遍历源工作表行，并遍历列数据。它使用您的oHeaderRow值来标识任务，并将其与我们所在的当前行的值相关联。

Sub Test()
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Sheet1")

    Dim ws2 As Worksheet
    Set ws2 = Sheets("Sheet2")

    Dim oHeaderRow As Long
    Dim oCurRow, oCurCol As Long
    Dim oDestRow As Long

    oHeaderRow = 4      ' Which Row your Source Header is on
    oDestRow = 2        ' Destination Start Row

    For oCurRow = 5 To 8        ' Can manipulate these (you already seem to know how)
        For oCurCol = 5 To 8    ' Columns to scan for headers & Data
            If Not IsEmpty(ws1.Cells(oCurRow, oCurCol)) Then
                If ws1.Cells(oCurRow, oCurCol) > 0 Then
                    ws2.Cells(oDestRow, "B") = ws1.Cells(3, 3)  ' Name
                    ' Other Fields...
                    ws2.Cells(oDestRow, "E") = ws1.Cells(oHeaderRow, oCurCol)   ' get Header Name
                    ws2.Cells(oDestRow, "F") = ws1.Cells(oCurRow, oCurCol)      ' get Value
                    oDestRow = oDestRow + 1
                End If
            End If
        Next
    Next
End Sub

（VBA）如何将数据从一张纸移动到另一张纸，向下和跨行移动以提取数据

2 个答案: