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

总共我推荐以下内容

为您的Application.InputBox引入一些错误处理，否则如果用户按下 Cancel 按钮会失败。
测试是否选择了多个区域（我们不知道如何处理它们，因此我们需要禁止它们）。
使用数组：将源范围读入数组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

范围输入

2 个答案:

总共我推荐以下内容