Excel 需要将列复制到新工作表，但某些单元格需要连接和清理

这是我第一次在excel中使用VBA和宏，或者说是excel。我非常感谢您能给我的任何帮助或见解，从函数到循环都能帮助我成功完成这项任务

我正在尝试通过以下方式设置此工作簿：

我得到一个必须重新排序的列表，以便导入到另一个系统中。宏的“我的任务列表”如下所示：

姓名和公司必须合并为一个，如果一个人有不同的姓名，则必须合并。每个公司标题不会有两个不同的公司。

每个公司的每个文件ID都必须连接起来

个人费用必须替换为每家公司的总费用。

按内部ID#A-Z排序

新工作表上只有一个页眉

看起来像这样：

我的代码如下所示：

子格式（）
Application.ScreenUpdating=False
'这是清除不必要单元格的设置'
变暗rCell As范围
乌鸦一样长，最后一排一样长
LastRow=工作表（“Sheet1”）.Range（“A”和Rows.Count）.End（xlUp）.Row
''删除合并的单元格''
带有工作表（“Sheet1”）.范围（“A1”，工作表（“Sheet1”）.范围（“A”&行数）。结束（xlUp））
做
设置c=.Find（What:=“*公司名称：”，后面：=[A1]，LookIn:=xlValues，LookAt:=xlPart，SearchOrder:=xlByColumns，SearchDirection:=xlNext，MatchCase:=False，SearchFormat:=False）
如果不是，那么c什么都不是
克罗=c.罗
c、 EntireRow.Delete
如果结束
循环而不是c是Nothing，cRow

---

再次感谢您在这件事上的帮助。谢谢！

有很多方法可以循环通过单元格。
我选择了带有公司名称的列

D

，因为它没有太多的混乱

通常最好找到最后一行，不要在我们不需要的单元格中循环。这样做的方法也很多。今天我们将介绍

范围（“D”和.Rows.Count）.End（xlUp）.row

对于循环，我们可以使用下一种方法，例如：

For i = 1 To Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
    If Not Cells(i, 4).Value = "" Then
Next i

但这一次，我对每个都使用了

，因为我认为它更具可读性

Sub groupingEach()
Dim entry As Variant, prev As String, lRow As Long, lRow2 As Long
Dim inSht As Worksheet, outSht As Worksheet
Set inSht = Sheets(1)
Set outSht = Sheets(2)
lRow = inSht.Range("D" & inSht.Rows.Count).End(xlUp).Row            'last row

For Each entry In inSht.Range("D1:D" & lRow)                        'loop 1st sheet
    lRow2 = outSht.Range("D" & outSht.Rows.Count).End(xlUp).Row     'last row in output
    If entry = prev And Not entry = "" Then
        '-Group'
        If InStr(outSht.Cells(lRow2, 3), entry.Offset(, 1)) = 0 Then 'does name exist?
            outSht.Cells(lRow2, 3) = outSht.Cells(lRow2, 3) & vbNewLine & entry.Offset(, 1)
        End If
        outSht.Cells(lRow2, 5) = outSht.Cells(lRow2, 5) & vbNewLine & entry.Offset(, -2)
        outSht.Cells(lRow2, 6) = outSht.Cells(lRow2, 6) + entry.Offset(, 2)
    ElseIf Not entry = prev And Not entry = "" And Not entry = "Company" Then
        '-New row
        prev = entry                                    'Save company name for comparison
        outSht.Cells(lRow2 + 1, 1) = entry.Offset(, -3)
        outSht.Cells(lRow2 + 1, 2) = "Payable"          'Where to get this value?
        outSht.Cells(lRow2 + 1, 3) = entry.Offset(, 1)
        outSht.Cells(lRow2 + 1, 4) = entry
        outSht.Cells(lRow2 + 1, 5) = entry.Offset(, -2)
        outSht.Cells(lRow2 + 1, 6) = entry.Offset(, 2)
    End If
Next entry

    outSht.Cells(lRow2 + 3, 1).Value = "Grand Total:"
    outSht.Cells(lRow2 + 3, 2).Formula = "=SUM(F:F)"
End Sub

从示例来看，这应该可以处理从示例到目标的所有文档。我想循环复制值，但列顺序的更改让它变得烦人

你的代码出了什么问题？你的需求太多了。我建议你列出哪些需求是你已经编写的，哪些没有，哪些没有，但不是你期望的方式。还要更清楚地说明你的代码的哪些部分需要帮助。像这样解析工作表中排列的数据既慢又耗时ming business。你需要逐行、逐单元格地读取每个单元格，并维护某种状态变量，以告知你所在的位置以及每段数据的用途。这是一个真正的PITA。但看起来你已经有了一个良好的开端。继续读下去，如果你有任何具体问题，请告诉我们谢谢大家的回答。我的代码目前正在删除删除所有标题，但未合并文件ID、名称或总计。是否有任何公式可用于合并这些文件编号，但不能合并行本身？如果我能找到方法，那么对名称进行合并应该没有问题。对于总计，有单元格包含总计，但我需要找到如何转置这是我第一次来这里，我再次感谢您的帮助，很抱歉我的问题不清楚。谢谢！我想我们可以假设分组中始终存在一致性，就像相同的公司名称不会出现多次（分组）。这使得将数据放在一起变得容易多了。非常感谢。你不知道这个项目给了我多大的麻烦。当我在报告中运行此代码时，应付款项在a列，B列中没有任何内容。你能和我一起谈谈我将如何解决此问题吗？再次感谢你，不用看它就说出来。W其余数据会发生什么情况？您的第一张工作表看起来像“示例”还是“当前”示例？输出工作表中的其他列中是否出现任何内容？代码不是超级动态的，因此必须与此设置完全一致。编辑：发现问题在于“应付”的偏移量“一栏。完全掩盖了这一点，直到我用调试运行它。这很好用。非常感谢你的帮助！哦，对了，我的错。忘了纠正那个小错误。很高兴你找到了。很乐意帮忙。非常感谢！对不起，这是一个负担，但有没有办法删除重复的名字，这样就只有一个“亚当·雷诺兹”？如果我需要在另一个问题中发布它，我可以。谢谢你的帮助！
Sub groupingEach()
Dim entry As Variant, prev As String, lRow As Long, lRow2 As Long
Dim inSht As Worksheet, outSht As Worksheet
Set inSht = Sheets(1)
Set outSht = Sheets(2)
lRow = inSht.Range("D" & inSht.Rows.Count).End(xlUp).Row            'last row

For Each entry In inSht.Range("D1:D" & lRow)                        'loop 1st sheet
    lRow2 = outSht.Range("D" & outSht.Rows.Count).End(xlUp).Row     'last row in output
    If entry = prev And Not entry = "" Then
        '-Group'
        If InStr(outSht.Cells(lRow2, 3), entry.Offset(, 1)) = 0 Then 'does name exist?
            outSht.Cells(lRow2, 3) = outSht.Cells(lRow2, 3) & vbNewLine & entry.Offset(, 1)
        End If
        outSht.Cells(lRow2, 5) = outSht.Cells(lRow2, 5) & vbNewLine & entry.Offset(, -2)
        outSht.Cells(lRow2, 6) = outSht.Cells(lRow2, 6) + entry.Offset(, 2)
    ElseIf Not entry = prev And Not entry = "" And Not entry = "Company" Then
        '-New row
        prev = entry                                    'Save company name for comparison
        outSht.Cells(lRow2 + 1, 1) = entry.Offset(, -3)
        outSht.Cells(lRow2 + 1, 2) = "Payable"          'Where to get this value?
        outSht.Cells(lRow2 + 1, 3) = entry.Offset(, 1)
        outSht.Cells(lRow2 + 1, 4) = entry
        outSht.Cells(lRow2 + 1, 5) = entry.Offset(, -2)
        outSht.Cells(lRow2 + 1, 6) = entry.Offset(, 2)
    End If
Next entry

    outSht.Cells(lRow2 + 3, 1).Value = "Grand Total:"
    outSht.Cells(lRow2 + 3, 2).Formula = "=SUM(F:F)"
End Sub