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

Question

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

WorkSheet1 - 输出：

工作表2 - 输入：

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

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

更新

抱歉，我应该更具体一点，在输出页面上，这是用户指定特定月份的区域。 （即用户可能会输入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

编辑tableHeight参数方程式

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