根据月份，如果不是空白，则从电子表格中提取行

Question

如果不是空白且月份匹配，我一直无法提出可以提取整行的公式。

WorkSheet1 - 输出：

工作表2 - 输入：

在Worksheet2 - 输入中，每个月是一个列标题。在下面的单元格中，有些是空的，有些则不是。

我需要找到一种方法来复制每个非空单元格的行，并将其粘贴到相应月份单元格的输出工作表中。

更新：

对不起，我应该更具体一点，在输出页面上，这是用户指定特定月份的区域。 （即用户可能会输入7月到9月，在这种情况下，我只需要查看7月8月到9月）

我会分享我之前尝试过的宏，但它主要是胡言乱语......

Answer 1

假设您的表以“A1”[row1 - date headers]开头，这里是代码：

Sub CleanData()
Dim arr() As Variant
Dim sh As Worksheet
lastcolumn = ActiveSheet.Range("A" & 1).End(xlToRight).Column
tableHeight = Range(Columns(1), Columns(lastcolumn)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


For i = 1 To lastcolumn
    y = 0
    For j = 1 To tableHeight
        If Cells(j, i) <> "" Then
           If longestcolumn <= y Then
                ReDim Preserve arr(lastcolumn - 1, y)
                arr(i - 1, y) = Cells(j, i)
                If j = 1 Then arr(i - 1, y) = MonthName(Month(Cells(j, i)))
                longestcolumn = y
                y = y + 1
            Else
                arr(i - 1, y) = Cells(j, i)
                If j = 1 Then arr(i - 1, y) = MonthName(Month(Cells(j, i)))
                y = y + 1
            End If
        End If
    Next j
Next i

Set sh = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
sh.Range(Cells(1, 1), Cells(longestcolumn, lastcolumn)) = Application.Transpose(arr)

End Sub

编辑表高度参数方程

Answer 2

根据您对输出页面的评论，该输出页面具有指定其中的月份Feed的区域，这应该得到您想要的。 CopyNonEmtpyRowsOver包含您所需信息的范围，以及您的目的地表。如果您的要求发生变化，并且您需要不同的输出表或信息来源更改，您可以在调用潜艇的位置更改它们以更清楚地了解您的意图。

Public Sub RowCopyProcedure()
    'Edit the argument of sourceRange determine your limits
    CopyNonEmtpyRowsOver Range(Sheet2.Cells(1, 1), Sheet2.Cells(11, "I")), Sheet1
End Sub

Private Sub CopyNonEmtpyRowsOver(ByVal sourceRange As Range, ByVal destinationSheet As Worksheet)

    Dim rowToMigrate As Range
    Dim populatedRows As Long
    Dim isRowPopulated As Boolean
    For Each rowToMigrate In sourceRange.Rows
        On Error Resume Next
            isRowPopulated = rowToMigrate.SpecialCells(xlCellTypeConstants).Count > 0
        On Error GoTo 0
        If isRowPopulated Then
            MigrateRowOver rowToMigrate, destinationSheet.Cells(populatedRows + 1, 1)
            populatedRows = populatedRows + 1
            isRowPopulated = False
        End If
    Next
End Sub

Private Sub MigrateRowOver(ByVal sourceRow As Range, ByVal destinationCell As Range)
    sourceRow.Copy destinationCell.Resize(ColumnSize:=sourceRow.Columns.Count)
End Sub