Question

我对vba相当新。在我决定发布这个问题之前，我做了一些研究并找到了类似的解决方案，但无法成功实现代码。 http://www.mrexcel.com/forum/excel-questions/715128-visual-basic-applications-copy-paste-entire-row-second-sheet-based-cell-value.html

我在Microsoft Excel 2010和Windows 7上。基本上，我使用外部软件将原始数据生成到名为＆＃34; Data。＆＃34;的空白工作簿表中。我想复制表格中的数据＆＃34;数据＆＃34;并将其呈现在名为＆＃34;摘要的表格中。＆＃34; （我想添加小计）：

使用SQL服务器，我将A列作为＆＃34; 1＆＃34;或＆＃34; 2。＆＃34;具有值＆＃34; 1＆＃34;的行将从第6行，第13页的第C列和第34页摘要开始。＆＃34;具有值＆＃34; 2＆＃34;的行在具有列标题的第一个数据集小计之后将开始两行。我还想从＆＃34;摘要＆＃34;中排除A列。片。我还包括了我开始研究的代码。我知道我插入的代码是错误的，这就是我发布这个问题的原因：

Sub CopyData()

Dim lr As Long, lr2 As Long, r As Long

lr = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row

For r = lr To 2 Step -1
  If Range("A" & r).Value = "1" Then
    Rows(r).Copy Destination:=Sheets("Summary").Range("A" & lr2 + 1)
    lr2 = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row
  End If
  If Range("A" & r).Value = "2" Then
    Rows(r).Copy Destination:=Sheets("Sheet1").Range("A" & lr2 + 1)
    lr3 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  End If
  Range("A1").Select
Next r

End Sub

我是否在正确的轨道上？有人可以帮忙吗？

Answer 1

宏运行时是否选择/激活了数据表？如果没有，那么无论哪个工作表处于活动状态，都将是从中复制数据的工作表。这一行：

Rows(r).Copy Destination:=Sheets("Summary").Range("A" & lr2 + 1)

...复制行＆＃34; r＆＃34;从活动表。如果你有＆＃34;摘要＆＃34;活跃，所以你可以看到你正在复制的＃34;摘要＆＃34;到＆＃34;摘要＆＃34;

所以，要么激活＆＃34;数据＆＃34;片：

Sheets("Data").Activate

或者在行前明确指定工作表：

Sheets("Data").Rows(r).Copy Destination:=Sheets("Summary").Range("A" & lr2 + 1)

编辑：

为了按列A为分组添加摘要行，您需要评估每个循环的A列，以查看下一个值是否与当前值相同。如果下一个值不相同，则需要插入摘要行。这还要求您有一个计数器，以便您知道必须汇总多少行。

因此，您需要包含一行来计算要分组的行数。所以这个：

If Range("A" & r).Value = "1" Then
  rowCount = rowCount + 1
  Sheets("Data").Rows(r).Copy Destination:=Sheets("Summary").Range("A" & lr2 + 1)
  lr2 = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row
End If

并且有条件语句在＆＃34; group＆＃34;时插入摘要行。完了：

If Range("A" & r).Value <> Range("A" & r - 1).Value Then
  'Do a bunch of stuff
End If

＆＃34;做一堆东西＆＃34;取决于你想做什么。也许在A栏中你什么都不做，B栏你总和，C栏你平均。这取决于您的喜好。例如，但是：

Sheets("Summary").Range("A" & r).FormulaR1C1 = "=SUM(R[-" & rowCount & "]C:R[-1]C)"

由于您要在一个工作表中添加行而不在另一个工作表中添加行，因此这可能会非常复杂并且变得更加复杂。我建议你玩这个，如果你需要进一步的帮助，提出一个新的问题。解释多部分问题变得混乱。并且有很多方法可以解决你的问题。

Answer 2

试试这个。我不认为您的数据集之间可能存在差距以实现Excel小计，您还需要列标题。如果您愿意，可以手动插入空白行。我已将行定义为noCols。对我来说，如果你只使用少数几个，那么复制超过16,000个cols是没有意义的吗？构建变量是一个好主意，一旦开始，你就可以更灵活地格式化（如果我误读了你的规范！）。我将把它留给你来计算如何从你的输出中得到你需要的总和/总数！我已经使用了一些额外的VBA语句，你可以自己研究这些语句来带你前进。

Sub CopyData()


Dim lr As Long, lr2 As Long, lr3 As Long
Dim oneStartRow As Long
Dim startCol As Long
Dim noCols As Long
Dim rc As Long


oneStartRow = 6
startCol = 1
noCols = 33
rc = 0

lr = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row

'headings
    For r = 1 To noCols
        Sheets("Summary").Cells(oneStartRow - 1, r).Value = "Col" & r
    Next r

'dataset 1     
    For r = 2 To lr
        If Sheets("Data").Cells(r, 1).Value = "1" Then
            Sheets("Data").Cells(r, 1).Resize(1, noCols).Copy
            Sheets("Summary").Cells(oneStartRow + rc, startCol).Select
            ActiveSheet.Paste
            rc = rc + 1
        End If
    Next r

    lr3 = Sheets("Summary").Cells(Rows.Count, 2).End(xlUp).Row
    rc = 0

'dataset 2
    For r = 2 To lr
        If Sheets("Data").Cells(r, 1).Value = "2" Then
            Sheets("Data").Cells(r, 1).Resize(1, noCols).Copy
            Sheets("Summary").Cells(lr3 + rc, startCol).Select
            ActiveSheet.Paste
            rc = rc + 1
        End If
    Next r

'subtotals        
    Sheets("Summary").Cells(8, 1).Select  'Anywhere in data to be grouped
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3, 4, 5, 6)  'Array = Col no's to be summed

'clear col A
    Sheets("Summary").Columns(1).ClearContents 

End Sub

Answer 3

或者......一种不同的方法首先对数据进行排序，然后使用稍短的代码自动检索最后一列

Sub CopyDatawithSort()

Dim sdRow As Long, sdCol As Long
Dim ssRow As Long, ssCol As Long

'data start r/c
sdRow = 2
sdCol = 1
'summary data start r/c
ssRow = 6
ssCol = 1

'last data row and column
ldrow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
ldCol = Sheets("Data").Cells(sdRow, Columns.Count).End(xlToLeft).Column

'sort data in order using column sdcol
Sheets("Data").Activate
    Sheets("Data").Range(Cells(sdRow, sdCol), Cells(ldrow, ldCol)).Select
    Selection.Sort Key1:=Columns(sdCol), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'summary sheet column headers
    For r = 1 To ldCol
        Sheets("Summary").Cells(ssRow - 1, r).Value = "Col" & r
    Next r

'copy data
    Sheets("Data").Range(Cells(sdRow, sdCol), Cells(ldrow, ldCol)).Copy _
    Destination:=Sheets("Summary").Cells(ssRow, ssCol)

'subtotals
    Sheets("Summary").Activate
    Sheets("Summary").Cells(ssRow, ssCol).Select
    Selection.Subtotal GroupBy:=ssCol, Function:=xlSum, TotalList:=Array(2, 3, 4, 5, 6)

'clear Col 1
    Sheets("Summary").Columns(ssCol).ClearContents

End Sub

编辑以满足其他问题

我不确定您是否可以使用Excel SubTotal功能删除Grand Total，因此您需要使用代码将其删除。请尝试以下方法：

Dim lsRow As Long
Dim gt As Range

并将以下代码段放在＆＃39; clear Col 1行

之前

'remove grandtotal
    lsRow = Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Row
    Set gt = Range(Cells(ssRow, ssCol), Cells(lsRow, ssCol)).Find(After:=Cells(ssRow, ssCol), What:="Grand Total", LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows)
    gt.EntireRow.Clear

根据单元格值复制行，然后添加小计

3 个答案: