Question

对于macros等我来说还是比较新的......我现在已经试图解决这个问题几天了！
我试图从大型数据电子表格中选择，根据特定单元格的内容选择特定单元格，然后粘贴到另一个工作表中。

来源电子表格：

列转到：站点，子位置，日期，月份，检查员，操作1，操作2等，每次检查最多67个操作。每行都是单独的检查提交

目标电子表格：

列转到：站点，子位置，日期，月份，检查员，操作，到期日期每行是一个单独的动作。我希望它跳过粘贴操作列中任何空白的值（因为不需要操作）。粘贴操作时，它还会粘贴前5列（包括站点名称，位置，日期等），以便可以将操作标识到正确的站点，日期等。

希望这是有道理的。最后，我希望目标电子表格能够根据人们的需要进行过滤，例如：截止日期或地点等。

我努力工作的代码...不幸的是我只能让它在第一行工作，然后它仍然粘贴空白（或零）值，我需要将它们过滤掉。我想某种循环来做所有的行。

Sub test1257pm()
Application.ScreenUpdating = False
    Sheets("Corrective Actions").Select
    Range("A3:E3").Select
    Selection.Copy
    Sheets("Corrective Actions Tracker").Select
    Range("A3").Select
    ActiveSheet.Paste

    Sheets("Corrective Actions").Select
    Range("F3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Corrective Actions Tracker").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

.Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial
    Rows("2:2").Select
    Selection.AutoFilter
    Range("F4").Select
    ActiveSheet.Range("$A$2:$L$300").AutoFilter Field:=6, Criteria1:=Array( _
        "CMC to conduct clean of ceiling fans. Close out by 17/04/2014", _
        "Provide bins", "Send to contractor", "="), Operator:=xlFilterValues

Application.ScreenUpdating = True
End Sub

非常感谢能给我任何帮助的人！：）

编辑：24-4-2014 好的，所以在L42的代码之后，如果我可以在将数据放入1列（堆叠）之前先简化我的数据，它就可以正常工作。我尝试的代码（使用宏录制器）是：

Sub Macro2()

Dim r As Range
Dim i As Integer

For i = 3 To 10

Range("P" & i).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy

Range("F" & i).Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=True, _
    IconFileName:=False

   Next i

End Sub

我的问题在于它会产生意想不到的结果......它并没有将它全部整合到我想要的行中。我认为这不是最佳解决方案......可能原始的宏需要改变......但是我不确定如何。

Answer 1

大修＃1：使用提供的示例数据

Option Explicit '~~> These two lines are important
Option Base 1

Sub StackMyActions()

Dim sourceWS As Worksheet, targetWS As Worksheet
Dim staticRng As Range, copyRng As Range
Dim inspCnt As Long, i As Long, fRow As Long, tRow As Long
Dim myactions

Set sourceWS = ThisWorkbook.Sheets("Corrective Actions")
Set targetWS = ThisWorkbook.Sheets("Corrective Actions Tracker")

With sourceWS
    '~~> count the total inspection
    '~~> here we incorporate .Find method finding the last cell not equal to 0
    inspCnt = .Range("A3", .Range("A:A").Find(0, [a2], _
        xlValues, xlWhole).Offset(-1, 0).Address).Rows.Count
    '~~> set the Ranges
    Set copyRng = .Range("F3:BT3")
    Set staticRng = .Range("A3:E3")
    '~~> loop through the ranges
    For i = 0 To inspCnt - 1
        '~~> here we use the additional code we have below
        '~~> which is GetCARng Function
        myactions = GetCARng(copyRng.Offset(i, 0))
        '~~> this line just checks if there is no action
        If Not IsArray(myactions) Then GoTo nextline
        '~~> copy and paste
        With targetWS
            fRow = .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0).Row
            tRow = fRow + UBound(myactions) - 1
            .Range("F" & fRow, "F" & tRow).Value = Application.Transpose(myactions)
            staticRng.Offset(i, 0).Copy
            .Range("A" & fRow, "A" & tRow).PasteSpecial xlPasteValues
        End With
nextline:
    Next
End With

End Sub

获取行动的功能：

Private Function GetCARng(rng As Range) As Variant
Dim cel As Range, x
For Each cel In rng
    If cel.Value <> 0 Then
        If IsArray(x) Then
            ReDim Preserve x(UBound(x) + 1)
        Else
            ReDim x(1)
        End If
        x(UBound(x)) = cel.Value
    End If
Next
GetCARng = x
End Function

<强>结果：
1：使用如下所示的样本数据：

Corrective Action Sheet

2：运行宏之后，堆叠如下数据：

Corrective Action Tracker

以上代码仅包含至少1个Action的插入。
例如，由于没有发布任何操作，由MsExample进行的Site 3没有反映在Corrective Actions Tracker Sheet上。
好吧，我真的无法解释它，上面使用的所有属性和方法。
只需查看以下链接，即可帮助您了解大部分内容：

Avoid Using Select
Using .Find Method
Returning Array From VBA Function

当然还有练习，练习，练习。

将包含文本的行的单元格复制到另一个工作表上的列

1 个答案: