输入范围

Question

不太确定我的代码有什么问题，但它不是一个直列打印。你说的时候会起作用

cells(i,j).copy
range(i,j).pastespecial

但是当你请求一系列值时，抛出单元格中的值是完全随机的，比如

set rng=Application.inputbox(" Please select range", Type=:8)

除非您请求用户选择范围，否则一切正常。

Sub select1()

Dim rng As Variant
Dim i, j, k As Integer

Set rng = Application.InputBox("please select range", Type:=8)

With ActiveSheet
  i = 1
  k = 1
  For j = 1 To rng.Columns.Count
     For i = 1 To rng.Rows.Count
       rng(Cells(i, j)).Copy
       Range("l" & k).PasteSpecial
       k = k + 1
     Next i
     i = 1
 Next j
End With

End Sub

所以对于这张桌子

jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda

我必须得到（在1栏）

jenny
jenny
jenny
jenny
jenny
doon
doon
doon
doon
doon
felix
felix
felix
felix
felix
spi
spi
spi
spi
spi
gav
gav
gav
gav
gav
benj
benj
benj
benj
benj

Answer 1

这个

rng(Cells(i, j)).Copy
Range("L" & k).PasteSpecial

应该

rng.Cells(i, j).Copy
.Range("L" & k).PasteSpecial

要么

rng.Cells(i, j).Copy Destination:=.Range("L" & k)

---

或者，如果您只想复制该值，那么这将更好：

.Range("L" & k).Value = rng.Cells(i, j).Value

---

In total I recommend the following

• 为Application.InputBox引入一些错误处理，否则如果用户按下取消按钮则失败。
• 测试是否选择了多个区域（我们不知道如何处理它们，因此我们需要禁止它们）。
• 使用数组：将源范围读入数组SrcArr = SrcRng.Value并使用数组输出ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant。这样，您只有一个单元读/写操作，这使您的代码更快。转换完全在阵列中执行。

所以你最终得到......

Option Explicit

Public Sub TransformRange()
    Dim SrcRng As Range
    On Error Resume Next 'next line throws error if user presses cancel so hide all errors
    Set SrcRng = Application.InputBox("please select range", Type:=8)
    On Error GoTo 0 'don't forget to re-activate error reporting

    If SrcRng Is Nothing Then Exit Sub

    If SrcRng.Areas.Count > 1 Then
        MsgBox "More than one area was selected I'm not sure what to do"
        Exit Sub
    End If

    'read everything into an array
    Dim SrcArr() As Variant
    SrcArr = SrcRng.Value

    'transform values
    ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant
    Dim iRow As Long, iCol As Long, iArr As Long
    iArr = 1 'initialize

    For iCol = 1 To UBound(SrcArr, 2)
        For iRow = 1 To UBound(SrcArr, 1)
            DestArr(iArr, 1) = SrcArr(iRow, iCol)
            iArr = iArr + 1
        Next iRow
    Next iCol

    'write values into sheet
    SrcRng.Parent.Range("L1").Resize(RowSize:=UBound(DestArr, 1)).Value = DestArr
    'SrcRng.Parent <-- this represents the sheet of the selected range
End Sub

Answer 2

这是另一种基于数组的方法，可能在您的其他常规应用程序中很有用。此例程可以将数据传输到sheet2。但是我已经评论了第二张纸的使用并且仅使用了活动纸。您可以根据您的要求更改参考。它对我来说正常工作，相关文件可供您在dropbox上参考。

   Sub FillWS3()
    Dim i As Long, j As Long, currentRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rng As Range
    Dim period As Variant
    Dim trperiod As Variant
    Dim ws1 As Worksheet, ws2 As Worksheet
    ' Set references to worksheets
    Set ws1 = ThisWorkbook.Worksheets("Worksheet1")
    Set ws2 = ThisWorkbook.Worksheets("Worksheet2")
      ' Determine last row in column A in worksheet1
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
      ' Determine last column in column A in worksheet1
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    currentRow = 1
    i = 1

    Set rng = Application.InputBox("please select range", Type:=8)
    period = rng.Value
    'period = ws1.Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
    trperiod = Application.Transpose(period)

    For i = LBound(trperiod, 1) To UBound(trperiod, 1)
        For j = LBound(trperiod, 2) To UBound(trperiod, 2)
            ws1.Cells(currentRow, 12).Value = trperiod(i, j)
            currentRow = currentRow + 1
        Next j
    Next i
End Sub

结果获得

编辑：根据@PEH的好建议，我删除了Transpose方法和修改过的数组循环。编辑代码如下。

   Sub FillWS3()
    Dim i As Long, j As Long, currentRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rng As Range
    Dim period As Variant
    Dim trperiod As Variant
    Dim ws1 As Worksheet, ws2 As Worksheet
    ' Set references to worksheets
    Set ws1 = ThisWorkbook.Worksheets("Worksheet1")
    Set ws2 = ThisWorkbook.Worksheets("Worksheet2")
      ' Determine last row in column A in worksheet1
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
      ' Determine last column in column A in worksheet1
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    currentRow = 1
    i = 1

    Set rng = Application.InputBox("please select range", Type:=8)
    period = rng.Value
    'period = ws1.Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
    'trperiod = Application.Transpose(period)

    For j = LBound(period, 2) To UBound(period, 2)
        For i = LBound(period, 1) To UBound(period, 1)
            ws1.Cells(currentRow, 12).Value = period(i, j)
            currentRow = currentRow + 1
        Next i
    Next j
End Sub