Question

我昨天发布并得到了一些帮助，让我开始了解我正在尝试做的事情，但不幸的是，我再次陷入困境。我有代码调用一个输入框，要求当天。输入日期后，它会在工作表中搜索包含它的单元格，然后将它们复制/粘贴到另一个工作表。

我似乎无法弄明白该怎么做，就是让它以我需要的方式粘贴。

到目前为止，这是我的代码：

Private Sub Run_Report_Click()
Dim chdate As Date, datestring As String

datestring = Application.InputBox("Enter Date (MM/DD/YY)", "Date")

If IsDate(datestring) Then
    chdate = DateValue(datestring)
Else
    MsgBox "Invalid Date"
Exit Sub
End If

'input box pop up to allow user to search for
'a specific date

Application.ScreenUpdating = False
Dim xRow, NextRow, LastRow
LastRow = Cells(Rows.Count, 1).End(xlUp).Rows
NextRow = 2
For xRow = 2 To LastRow
    If InStr(Cells(xRow, 1).Value, chdate) > 0 Then
        Rows(xRow).Copy Sheets("TEMP").Rows(NextRow)
        NextRow = NextRow + 1
    End If
    Next xRow
Application.ScreenUpdating = True


MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & chdate & "''" & " were copied to TEMP.", 64, "Done"
    End Sub

它从15个不同的列中提取数据，并按原样粘贴指定的行。但是，我不知道如何做到这一点使它将一些信息粘贴到不同行下的同一列中。有点像这样。

1a 1a 3a 3a 4a 5a 6a 1b 2b 3b 4b 5b 6b

到

1a 2a 6a
3A
4A
5A
1b 2b 6b
3B
4B
图5b

然后继续选择所选日期的其余数据。非常感谢任何帮助，谢谢。

Answer 1

使用以下代码代替循环（您可以保留输入框代码）。

Dim wsActive As Worksheet
Dim wsTemp As Worksheet
Dim nRowActive As Long
Dim nCounter As Long
Dim xRow As Long
Dim nRowToUse As Long

Const IADDEND As Integer = 2

Set wsActive = ActiveSheet
Set wsTemp = Sheets("TEMP")

nRowActive = wsActive.Cells(Rows.Count, 1).End(xlUp).Row
nCounter = 0

For xRow = 2 To nRowActive
    nRowToUse = nCounter * 4 + IADDEND
    wsTemp.Cells(nRowToUse, 1).Value = wsActive.Cells(xRow, 1).Value
    wsTemp.Cells(nRowToUse, 2).Value = wsActive.Cells(xRow, 2).Value
    wsTemp.Cells(nRowToUse + 1, 1).Value = wsActive.Cells(xRow, 3).Value
    wsTemp.Cells(nRowToUse + 2, 1).Value = wsActive.Cells(xRow, 4).Value
    wsTemp.Cells(nRowToUse + 3, 1).Value = wsActive.Cells(xRow, 5).Value
    wsTemp.Cells(nRowToUse, 3).Value = wsActive.Cells(xRow, 6).Value
    nCounter = nCounter + 1
Next xRow

如果这有帮助，请告诉我。

将行中的单元格复制并粘贴到不同的列中

1 个答案: