Excel VBA，将xlsx划分为多张图纸

我不经常使用VBA，所以我需要一些帮助。 .xlsx，列标题位于第1行。第一张工作表名为“已提交” 第一栏是“年金”和我要找的东西。此列下将显示名称。名称和行数不断变化。（问题：某些单元格可能有多个名称以“，”分隔，并且名称将在多个单元格中列出）exp:

I2=“约翰·多伊”

---

I3是“约翰·多伊”

---

I4是“John Doe，Jane Doe”（如果发生这种情况，我们只需要第一个完整的名字，停在“，”

---

I5是“Jane Doe”等等

需要做的是，每一行都需要剪切并粘贴到一张新的表格上，标题为“Column I_Submitted”，标题为“Column I_Submitted”，具有相同的列标题，并将所有的John Doe和Jane Doe合并在一张表格上

一旦这张纸被清除，下一张纸将被“支付”，执行与“提交”相同的操作 最后一张是表“YTD”，在这张表上，我们要读“D”列，它的处理过程与其他两张表完全相同

---

感谢您的帮助。

对于VBA新手来说，这无疑是一件令人望而生畏的事情。这里有很多小片段可能很难理解，比如循环每一行，创建一个新的工作表，确定您要复制到的工作表中的哪一行是最后一行，确定如何从逗号分隔符中获取名字d名单等

下面的代码应该完全符合您的需要。我在每一行之前都做了大量的注释来解释它在做什么。它应该给您一个坚实的起点

Sub splitUpRows()

    'set up a variable to hold the worksheet from which we will be reading each row
    Dim ws_read As Worksheet
    Set ws_read = ThisWorkbook.Sheets("Submitted")

    'set up a variable to hold the worksheet to which we will write the data
    Dim ws_write As Worksheet

    'A variable to hold whether the ws_write sheet already exists
    Dim ws_write_exists As Boolean

    'A variable to hold which row we are reading, and one to hold which row we are writing
    Dim readRow As Integer, writeRow As Integer

    'A variable to hold the name of the person we are processing
    Dim str_name As String

    'Now loop from row 2 to the last row in the ws_read worksheet
    For readRow = 2 To ws_read.Range("A50000").End(xlUp).Row

        'get the name of the person (or if there are two, get the first one)
        'There are few ways to get the firstname, but here I am "Splitting"
        '  the value in Column I for this row to an array. I am then requesting
        '  the 1st item "(0)" from that array.
        'This is a nice way of doing it because you could quickly 
        '  change this to a for loop for each item in the array
        '  in case you wanted a row for each person from the same line.
        str_name = Split(ws_read.Cells(readRow, 9).Value, ",")(0)

        'Check to see if this sheet already exists by looping through all
        'of the worksheets in this workbook.
        'If it does, then set the ws_write_exists to true and exit the loop
        ws_write_exists = False
        For Each ws_write In ThisWorkbook.Worksheets
            If ws_write.Name = str_name Then ws_write_exists = True: Exit For
        Next ws_write

        'If it doesn't exist, then make it.
        'If it does exist, then it's already set to the right worksheet so
        'no worries just move along.
        If Not ws_write_exists Then

            'Add a new worksheet
            Set ws_write = ThisWorkbook.Worksheets.Add

            'name it after the person
            ws_write.Name = str_name

            'And copy the header row from ws_read to the first row of ws_write
            ws_write.Rows(1).Value2 = ws_read.Rows(1).Value2
        End If

        'So now we definitely have a worksheet for this person
        'And we definitely have ws_write set to that worksheet
        'Lets figure out what row we are writing to
        writeRow = ws_write.Range("A50000").End(xlUp).Row + 1

        'And now lets copy from ws_read to ws_write
        ws_write.Rows(writeRow).Value2 = ws_read.Rows(readRow).Value2
    Next readRow


End Sub

---

要在你的“已付”工作表上实现这一点，只需将ws_的读数改为指向“已付”。对于你的“YTD”工作表您必须更改ws_read，并将str_名称更改为指向第4列而不是第9列。

是的，打开编辑器并尝试成功创建一个循环来读取名称，但是从我在这里的帖子中可以看出，我根本不处理VBA。我甚至回到了我过去的问题，因为我认为我可以想出一些什么我不需要从那里得到帮助，但像我这样得到帮助的人最沮丧的部分是“聪明”帮助你的人没有时间告诉你他们为什么要做他们所做的事情，所以几乎不可能学习，因为我们中的一些人每年只使用VBA 1或2次。感谢你表达你的沮丧。JNevill，我不知道这是否有效，但这太棒了。我给你投票只是为了评论。我喜欢能够阅读代码看看它的用意是什么！太棒了！是的！没有什么比用一堆没有任何注释的代码来减轻打击更糟糕的了。我刚刚用一个伪标题运行了一个3或4行的测试，它在我眨眼之前就吹了，所以我想你会有好运的。你会看到它复制了整行，是吗o如果您有其他数据挂在右边的列中，那么您也会选择这些数据。这里只是一个警告。上传。我现在将尝试以这种格式回答问题。谢谢sir@JNevill.Awesome，谢谢你们两位。非常感谢。非常好用。非常好用，我正在尝试用它做一些其他事情，我将处理评论还有一些研究……再次感谢！我很高兴听到它正在做这项工作。如果你遇到任何问题或后续类型的问题，请继续在这里创建一个全新的问题。这样，它会吸引更多的眼球。这里有一些非常有知识的人。